1 /* Support for printing Ada types for GDB, the GNU debugger.
2 Copyright 1986, 1988, 1989, 1991, 1997, 2003 Free Software
5 This file is part of GDB.
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 2 of the License, or
10 (at your option) any later version.
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.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
22 #include "gdb_obstack.h"
23 #include "bfd.h" /* Binary File Description */
26 #include "expression.h"
35 #include "typeprint.h"
39 #include "gdb_string.h"
42 static int print_record_field_types (struct type *, struct type *,
43 struct ui_file *, int, int);
45 static void print_array_type (struct type *, struct ui_file *, int, int);
47 static void print_choices (struct type *, int, struct ui_file *,
50 static void print_range (struct type *, struct ui_file *);
52 static void print_range_bound (struct type *, char *, int *,
56 print_dynamic_range_bound (struct type *, const char *, int,
57 const char *, struct ui_file *);
59 static void print_range_type_named (char *, struct ui_file *);
63 static char *name_buffer;
64 static int name_buffer_len;
66 /* The (demangled) Ada name of TYPE. This value persists until the
70 demangled_type_name (struct type *type)
72 if (ada_type_name (type) == NULL)
76 char *raw_name = ada_type_name (type);
79 if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
81 name_buffer_len = 16 + 2 * strlen (raw_name);
82 name_buffer = xrealloc (name_buffer, name_buffer_len);
84 strcpy (name_buffer, raw_name);
86 s = (char *) strstr (name_buffer, "___");
90 s = name_buffer + strlen (name_buffer) - 1;
91 while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
100 for (s = q = name_buffer; *s != '\0'; q += 1)
102 if (s[0] == '_' && s[1] == '_')
119 /* Print a description of a type in the format of a
120 typedef for the current language.
121 NEW is the new name for a type TYPE. */
124 ada_typedef_print (struct type *type, struct symbol *new,
125 struct ui_file *stream)
127 fprintf_filtered (stream, "type %.*s is ",
128 ada_name_prefix_len (SYMBOL_PRINT_NAME (new)),
129 SYMBOL_PRINT_NAME (new));
130 type_print (type, "", stream, 1);
133 /* Print range type TYPE on STREAM. */
136 print_range (struct type *type, struct ui_file *stream)
138 struct type *target_type;
139 target_type = TYPE_TARGET_TYPE (type);
140 if (target_type == NULL)
143 switch (TYPE_CODE (target_type))
145 case TYPE_CODE_RANGE:
152 target_type = builtin_type_ada_int;
156 if (TYPE_NFIELDS (type) < 2)
158 /* A range needs at least 2 bounds to be printed. If there are less
159 than 2, just print the type name instead of the range itself.
160 This check handles cases such as characters, for example.
162 Note that if the name is not defined, then we don't print anything.
164 fprintf_filtered (stream, "%.*s",
165 ada_name_prefix_len (TYPE_NAME (type)),
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 =
174 (LONGEST) TYPE_FIELD_BITPOS (type, TYPE_NFIELDS (type) - 1);
176 ada_print_scalar (target_type, lower_bound, stream);
177 fprintf_filtered (stream, " .. ");
178 ada_print_scalar (target_type, upper_bound, stream);
182 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
183 set *N past the bound and its delimiter, if any. */
186 print_range_bound (struct type *type, char *bounds, int *n,
187 struct ui_file *stream)
190 if (ada_scan_number (bounds, *n, &B, n))
192 ada_print_scalar (type, B, stream);
193 if (bounds[*n] == '_')
199 char *bound = bounds + *n;
202 pend = strstr (bound, "__");
204 *n += bound_len = strlen (bound);
207 bound_len = pend - bound;
210 fprintf_filtered (stream, "%.*s", bound_len, bound);
214 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
215 the value (if found) of the bound indicated by SUFFIX ("___L" or
216 "___U") according to the ___XD conventions. */
219 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
220 const char *suffix, struct ui_file *stream)
222 static char *name_buf = NULL;
223 static size_t name_buf_len = 0;
227 GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
228 strncpy (name_buf, name, name_len);
229 strcpy (name_buf + name_len, suffix);
231 B = get_int_var_value (name_buf, 0, &OK);
233 ada_print_scalar (type, B, stream);
235 fprintf_filtered (stream, "?");
238 /* Print the range type named NAME. */
241 print_range_type_named (char *name, struct ui_file *stream)
243 struct type *raw_type = ada_find_any_type (name);
244 struct type *base_type;
248 if (raw_type == NULL)
249 base_type = builtin_type_int;
250 else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
251 base_type = TYPE_TARGET_TYPE (raw_type);
253 base_type = raw_type;
255 subtype_info = strstr (name, "___XD");
256 if (subtype_info == NULL && raw_type == NULL)
257 fprintf_filtered (stream, "? .. ?");
258 else if (subtype_info == NULL)
259 print_range (raw_type, stream);
262 int prefix_len = subtype_info - name;
267 bounds_str = strchr (subtype_info, '_');
270 if (*subtype_info == 'L')
272 print_range_bound (raw_type, bounds_str, &n, stream);
276 print_dynamic_range_bound (raw_type, name, prefix_len, "___L",
279 fprintf_filtered (stream, " .. ");
281 if (*subtype_info == 'U')
282 print_range_bound (raw_type, bounds_str, &n, stream);
284 print_dynamic_range_bound (raw_type, name, prefix_len, "___U",
289 /* Print enumerated type TYPE on STREAM. */
292 print_enum_type (struct type *type, struct ui_file *stream)
294 int len = TYPE_NFIELDS (type);
297 fprintf_filtered (stream, "(");
301 for (i = 0; i < len; i++)
305 fprintf_filtered (stream, ", ");
307 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
308 if (lastval != TYPE_FIELD_BITPOS (type, i))
310 fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
311 lastval = TYPE_FIELD_BITPOS (type, i);
315 fprintf_filtered (stream, ")");
318 /* Print representation of Ada fixed-point type TYPE on STREAM. */
321 print_fixed_point_type (struct type *type, struct ui_file *stream)
323 DOUBLEST delta = ada_delta (type);
324 DOUBLEST small = ada_fixed_to_float (type, 1.0);
327 fprintf_filtered (stream, "delta ??");
330 fprintf_filtered (stream, "delta %g", (double) delta);
332 fprintf_filtered (stream, " <'small = %g>", (double) small);
336 /* Print representation of special VAX floating-point type TYPE on STREAM. */
339 print_vax_floating_point_type (struct type *type, struct ui_file *stream)
341 fprintf_filtered (stream, "<float format %c>",
342 ada_vax_float_type_suffix (type));
345 /* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
346 recursion (indentation) level, in case the element type itself has
347 nested structure, and SHOW is the number of levels of internal
348 structure to show (see ada_print_type). */
351 print_array_type (struct type *type, struct ui_file *stream, int show,
358 fprintf_filtered (stream, "array (");
362 fprintf_filtered (stream, "...");
365 if (ada_is_packed_array_type (type))
366 type = ada_coerce_to_simple_array_type (type);
367 if (ada_is_simple_array (type))
369 struct type *range_desc_type =
370 ada_find_parallel_type (type, "___XA");
371 struct type *arr_type;
374 if (range_desc_type == NULL)
376 for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
377 arr_type = TYPE_TARGET_TYPE (arr_type))
379 if (arr_type != type)
380 fprintf_filtered (stream, ", ");
381 print_range (TYPE_INDEX_TYPE (arr_type), stream);
382 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
383 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
389 n_indices = TYPE_NFIELDS (range_desc_type);
390 for (k = 0, arr_type = type;
392 k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
395 fprintf_filtered (stream, ", ");
396 print_range_type_named (TYPE_FIELD_NAME
397 (range_desc_type, k), stream);
398 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
399 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
406 for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
407 fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
411 fprintf_filtered (stream, ") of ");
413 ada_print_type (ada_array_element_type (type, n_indices), "", stream,
414 show == 0 ? 0 : show - 1, level + 1);
416 fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
419 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
420 STREAM, assuming the VAL_TYPE is the type of the values. */
423 print_choices (struct type *type, int field_num, struct ui_file *stream,
424 struct type *val_type)
428 const char *name = TYPE_FIELD_NAME (type, field_num);
432 /* Skip over leading 'V': NOTE soon to be obsolete. */
435 if (!ada_scan_number (name, 1, NULL, &p))
451 fprintf_filtered (stream, " | ");
461 if (!ada_scan_number (name, p + 1, &W, &p))
463 ada_print_scalar (val_type, W, stream);
469 if (!ada_scan_number (name, p + 1, &L, &p)
470 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
472 ada_print_scalar (val_type, L, stream);
473 fprintf_filtered (stream, " .. ");
474 ada_print_scalar (val_type, U, stream);
478 fprintf_filtered (stream, "others");
485 fprintf_filtered (stream, "??");
489 /* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
490 discriminant is contained in OUTER_TYPE, print its variants on STREAM.
491 LEVEL is the recursion
492 (indentation) level, in case any of the fields themselves have
493 nested structure, and SHOW is the number of levels of internal structure
494 to show (see ada_print_type). For this purpose, fields nested in a
495 variant part are taken to be at the same level as the fields
496 immediately outside the variant part. */
499 print_variant_clauses (struct type *type, int field_num,
500 struct type *outer_type, struct ui_file *stream,
504 struct type *var_type;
505 struct type *discr_type;
507 var_type = TYPE_FIELD_TYPE (type, field_num);
508 discr_type = ada_variant_discrim_type (var_type, outer_type);
510 if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
512 var_type = TYPE_TARGET_TYPE (var_type);
513 if (TYPE_FLAGS (var_type) & TYPE_FLAG_STUB)
515 var_type = ada_find_parallel_type (var_type, "___XVU");
516 if (var_type == NULL)
521 for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
523 fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
524 print_choices (var_type, i, stream, discr_type);
525 fprintf_filtered (stream, " =>");
526 if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
527 outer_type, stream, show, level + 4) <= 0)
528 fprintf_filtered (stream, " null;");
532 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
533 discriminants are contained in OUTER_TYPE, print a description of it
534 on STREAM. LEVEL is the recursion (indentation) level, in case any of
535 the fields themselves have nested structure, and SHOW is the number of
536 levels of internal structure to show (see ada_print_type). For this
537 purpose, fields nested in a variant part are taken to be at the same
538 level as the fields immediately outside the variant part. */
541 print_variant_part (struct type *type, int field_num, struct type *outer_type,
542 struct ui_file *stream, int show, int level)
544 fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
545 ada_variant_discrim_name
546 (TYPE_FIELD_TYPE (type, field_num)));
547 print_variant_clauses (type, field_num, outer_type, stream, show,
549 fprintf_filtered (stream, "\n%*send case;", level + 4, "");
552 /* Print a description on STREAM of the fields in record type TYPE, whose
553 discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
554 level, in case any of the fields themselves have nested structure,
555 and SHOW is the number of levels of internal structure to show
556 (see ada_print_type). Does not print parent type information of TYPE.
557 Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
558 Prints each field beginning on a new line, but does not put a new line at
562 print_record_field_types (struct type *type, struct type *outer_type,
563 struct ui_file *stream, int show, int level)
568 len = TYPE_NFIELDS (type);
570 if (len == 0 && (TYPE_FLAGS (type) & TYPE_FLAG_STUB) != 0)
573 for (i = 0; i < len; i += 1)
577 if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
579 else if (ada_is_wrapper_field (type, i))
580 flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
581 stream, show, level);
582 else if (ada_is_variant_part (type, i))
584 print_variant_part (type, i, outer_type, stream, show, level);
590 fprintf_filtered (stream, "\n%*s", level + 4, "");
591 ada_print_type (TYPE_FIELD_TYPE (type, i),
592 TYPE_FIELD_NAME (type, i),
593 stream, show - 1, level + 4);
594 fprintf_filtered (stream, ";");
601 /* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
602 level, in case the element type itself has nested structure, and SHOW is
603 the number of levels of internal structure to show (see ada_print_type). */
606 print_record_type (struct type *type0, struct ui_file *stream, int show,
609 struct type *parent_type;
613 if (TYPE_FLAGS (type) & TYPE_FLAG_STUB)
615 struct type *type1 = ada_find_parallel_type (type, "___XVE");
620 parent_type = ada_parent_type (type);
621 if (ada_type_name (parent_type) != NULL)
622 fprintf_filtered (stream, "new %s with ",
623 demangled_type_name (parent_type));
624 else if (parent_type == NULL && ada_is_tagged_type (type))
625 fprintf_filtered (stream, "tagged ");
627 fprintf_filtered (stream, "record");
630 fprintf_filtered (stream, " ... end record");
636 if (parent_type != NULL && ada_type_name (parent_type) == NULL)
637 flds += print_record_field_types (parent_type, parent_type,
638 stream, show, level);
639 flds += print_record_field_types (type, type, stream, show, level);
642 fprintf_filtered (stream, "\n%*send record", level, "");
644 fprintf_filtered (stream, " <incomplete type> end record");
646 fprintf_filtered (stream, " null; end record");
650 /* Print the unchecked union type TYPE in something resembling Ada
651 format on STREAM. LEVEL is the recursion (indentation) level
652 in case the element type itself has nested structure, and SHOW is the
653 number of levels of internal structure to show (see ada_print_type). */
655 print_unchecked_union_type (struct type *type, struct ui_file *stream,
658 fprintf_filtered (stream, "record (?) is");
661 fprintf_filtered (stream, " ... end record");
662 else if (TYPE_NFIELDS (type) == 0)
663 fprintf_filtered (stream, " null; end record");
668 fprintf_filtered (stream, "\n%*scase ? is", level + 4, "");
670 for (i = 0; i < TYPE_NFIELDS (type); i += 1)
672 fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
674 ada_print_type (TYPE_FIELD_TYPE (type, i),
675 TYPE_FIELD_NAME (type, i),
676 stream, show - 1, level + 12);
677 fprintf_filtered (stream, ";");
680 fprintf_filtered (stream, "\n%*send case;\n%*send record",
681 level + 4, "", level, "");
687 /* Print function or procedure type TYPE on STREAM. Make it a header
688 for function or procedure NAME if NAME is not null. */
691 print_func_type (struct type *type, struct ui_file *stream, char *name)
693 int i, len = TYPE_NFIELDS (type);
695 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
696 fprintf_filtered (stream, "procedure");
698 fprintf_filtered (stream, "function");
700 if (name != NULL && name[0] != '\0')
701 fprintf_filtered (stream, " %s", name);
705 fprintf_filtered (stream, " (");
706 for (i = 0; i < len; i += 1)
710 fputs_filtered ("; ", stream);
713 fprintf_filtered (stream, "a%d: ", i + 1);
714 ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
716 fprintf_filtered (stream, ")");
719 if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
721 fprintf_filtered (stream, " return ");
722 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
727 /* Print a description of a type TYPE0.
728 Output goes to STREAM (via stdio).
729 If VARSTRING is a non-empty string, print as an Ada variable/field
731 SHOW+1 is the maximum number of levels of internal type structure
732 to show (this applies to record types, enumerated types, and
734 SHOW is the number of levels of internal type structure to show
735 when there is a type name for the SHOWth deepest level (0th is
737 When SHOW<0, no inner structure is shown.
738 LEVEL indicates level of recursion (for nested definitions). */
741 ada_print_type (struct type *type0, char *varstring, struct ui_file *stream,
746 struct type *type = ada_completed_type (ada_get_base_type (type0));
747 char *type_name = demangled_type_name (type);
748 int is_var_decl = (varstring != NULL && varstring[0] != '\0');
753 fprintf_filtered (stream, "%.*s: ",
754 ada_name_prefix_len (varstring), varstring);
755 fprintf_filtered (stream, "<null type?>");
760 CHECK_TYPEDEF (type);
762 if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
763 fprintf_filtered (stream, "%.*s: ",
764 ada_name_prefix_len (varstring), varstring);
766 if (type_name != NULL && show <= 0)
768 fprintf_filtered (stream, "%.*s",
769 ada_name_prefix_len (type_name), type_name);
773 if (ada_is_aligner_type (type))
774 ada_print_type (ada_aligned_type (type), "", stream, show, level);
775 else if (ada_is_packed_array_type (type))
776 print_array_type (type, stream, show, level);
778 switch (TYPE_CODE (type))
781 fprintf_filtered (stream, "<");
782 c_print_type (type, "", stream, show, level);
783 fprintf_filtered (stream, ">");
786 fprintf_filtered (stream, "access ");
787 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
790 fprintf_filtered (stream, "<ref> ");
791 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
793 case TYPE_CODE_ARRAY:
794 print_array_type (type, stream, show, level);
797 if (ada_is_fixed_point_type (type))
798 print_fixed_point_type (type, stream);
799 else if (ada_is_vax_floating_type (type))
800 print_vax_floating_point_type (type, stream);
803 char *name = ada_type_name (type);
804 if (!ada_is_range_type_name (name))
805 fprintf_filtered (stream, "<%d-byte integer>",
809 fprintf_filtered (stream, "range ");
810 print_range_type_named (name, stream);
814 case TYPE_CODE_RANGE:
815 if (ada_is_fixed_point_type (type))
816 print_fixed_point_type (type, stream);
817 else if (ada_is_vax_floating_type (type))
818 print_vax_floating_point_type (type, stream);
819 else if (ada_is_modular_type (type))
820 fprintf_filtered (stream, "mod %ld", (long) ada_modulus (type));
823 fprintf_filtered (stream, "range ");
824 print_range (type, stream);
828 fprintf_filtered (stream, "<%d-byte float>", TYPE_LENGTH (type));
832 fprintf_filtered (stream, "(...)");
834 print_enum_type (type, stream);
836 case TYPE_CODE_STRUCT:
837 if (ada_is_array_descriptor (type))
838 print_array_type (type, stream, show, level);
839 else if (ada_is_bogus_array_descriptor (type))
840 fprintf_filtered (stream,
841 "array (?) of ? (<mal-formed descriptor>)");
843 print_record_type (type, stream, show, level);
845 case TYPE_CODE_UNION:
846 print_unchecked_union_type (type, stream, show, level);
849 print_func_type (type, stream, varstring);