1 /* Support for printing Ada types for GDB, the GNU debugger.
2 Copyright (C) 1986, 1988, 1989, 1991, 1997, 1998, 1999, 2000, 2001, 2002,
3 2003, 2004, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
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 3 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, see <http://www.gnu.org/licenses/>. */
21 #include "gdb_obstack.h"
22 #include "bfd.h" /* Binary File Description */
25 #include "expression.h"
34 #include "typeprint.h"
38 #include "gdb_string.h"
41 static int print_selected_record_field_types (struct type *, struct type *,
43 struct ui_file *, int, int);
45 static int print_record_field_types (struct type *, struct type *,
46 struct ui_file *, int, int);
48 static void print_array_type (struct type *, struct ui_file *, int, int);
50 static int print_choices (struct type *, int, struct ui_file *,
53 static void print_range (struct type *, struct ui_file *);
55 static void print_range_bound (struct type *, char *, int *,
59 print_dynamic_range_bound (struct type *, const char *, int,
60 const char *, struct ui_file *);
62 static void print_range_type (struct type *, struct ui_file *);
66 static char *name_buffer;
67 static int name_buffer_len;
69 /* The (decoded) Ada name of TYPE. This value persists until the
73 decoded_type_name (struct type *type)
75 if (ada_type_name (type) == NULL)
79 char *raw_name = ada_type_name (type);
82 if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
84 name_buffer_len = 16 + 2 * strlen (raw_name);
85 name_buffer = xrealloc (name_buffer, name_buffer_len);
87 strcpy (name_buffer, raw_name);
89 s = (char *) strstr (name_buffer, "___");
93 s = name_buffer + strlen (name_buffer) - 1;
94 while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
103 for (s = q = name_buffer; *s != '\0'; q += 1)
105 if (s[0] == '_' && s[1] == '_')
121 /* Print TYPE on STREAM, preferably as a range. */
124 print_range (struct type *type, struct ui_file *stream)
126 switch (TYPE_CODE (type))
128 case TYPE_CODE_RANGE:
131 struct type *target_type;
132 target_type = TYPE_TARGET_TYPE (type);
133 if (target_type == NULL)
135 ada_print_scalar (target_type, ada_discrete_type_low_bound (type),
137 fprintf_filtered (stream, " .. ");
138 ada_print_scalar (target_type, ada_discrete_type_high_bound (type),
143 fprintf_filtered (stream, "%.*s",
144 ada_name_prefix_len (TYPE_NAME (type)),
150 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
151 set *N past the bound and its delimiter, if any. */
154 print_range_bound (struct type *type, char *bounds, int *n,
155 struct ui_file *stream)
159 if (ada_scan_number (bounds, *n, &B, n))
161 /* STABS decodes all range types which bounds are 0 .. -1 as
162 unsigned integers (ie. the type code is TYPE_CODE_INT, not
163 TYPE_CODE_RANGE). Unfortunately, ada_print_scalar() relies
164 on the unsigned flag to determine whether the bound should
165 be printed as a signed or an unsigned value. This causes
166 the upper bound of the 0 .. -1 range types to be printed as
167 a very large unsigned number instead of -1.
168 To workaround this stabs deficiency, we replace the TYPE by NULL
169 to indicate default output when we detect that the bound is negative,
170 and the type is a TYPE_CODE_INT. The bound is negative when
171 'm' is the last character of the number scanned in BOUNDS. */
172 if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
174 ada_print_scalar (type, B, stream);
175 if (bounds[*n] == '_')
181 char *bound = bounds + *n;
184 pend = strstr (bound, "__");
186 *n += bound_len = strlen (bound);
189 bound_len = pend - bound;
192 fprintf_filtered (stream, "%.*s", bound_len, bound);
196 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
197 the value (if found) of the bound indicated by SUFFIX ("___L" or
198 "___U") according to the ___XD conventions. */
201 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
202 const char *suffix, struct ui_file *stream)
204 static char *name_buf = NULL;
205 static size_t name_buf_len = 0;
209 GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
210 strncpy (name_buf, name, name_len);
211 strcpy (name_buf + name_len, suffix);
213 B = get_int_var_value (name_buf, &OK);
215 ada_print_scalar (type, B, stream);
217 fprintf_filtered (stream, "?");
220 /* Print RAW_TYPE as a range type, using any bound information
221 following the GNAT encoding (if available). */
224 print_range_type (struct type *raw_type, struct ui_file *stream)
227 struct type *base_type;
230 gdb_assert (raw_type != NULL);
231 name = TYPE_NAME (raw_type);
232 gdb_assert (name != NULL);
234 if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
235 base_type = TYPE_TARGET_TYPE (raw_type);
237 base_type = raw_type;
239 subtype_info = strstr (name, "___XD");
240 if (subtype_info == NULL)
241 print_range (raw_type, stream);
244 int prefix_len = subtype_info - name;
249 bounds_str = strchr (subtype_info, '_');
252 if (*subtype_info == 'L')
254 print_range_bound (base_type, bounds_str, &n, stream);
258 print_dynamic_range_bound (base_type, name, prefix_len, "___L",
261 fprintf_filtered (stream, " .. ");
263 if (*subtype_info == 'U')
264 print_range_bound (base_type, bounds_str, &n, stream);
266 print_dynamic_range_bound (base_type, name, prefix_len, "___U",
271 /* Print enumerated type TYPE on STREAM. */
274 print_enum_type (struct type *type, struct ui_file *stream)
276 int len = TYPE_NFIELDS (type);
279 fprintf_filtered (stream, "(");
283 for (i = 0; i < len; i++)
287 fprintf_filtered (stream, ", ");
289 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
290 if (lastval != TYPE_FIELD_BITPOS (type, i))
292 fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
293 lastval = TYPE_FIELD_BITPOS (type, i);
297 fprintf_filtered (stream, ")");
300 /* Print representation of Ada fixed-point type TYPE on STREAM. */
303 print_fixed_point_type (struct type *type, struct ui_file *stream)
305 DOUBLEST delta = ada_delta (type);
306 DOUBLEST small = ada_fixed_to_float (type, 1.0);
309 fprintf_filtered (stream, "delta ??");
312 fprintf_filtered (stream, "delta %g", (double) delta);
314 fprintf_filtered (stream, " <'small = %g>", (double) small);
318 /* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
319 recursion (indentation) level, in case the element type itself has
320 nested structure, and SHOW is the number of levels of internal
321 structure to show (see ada_print_type). */
324 print_array_type (struct type *type, struct ui_file *stream, int show,
330 if (ada_is_constrained_packed_array_type (type))
331 type = ada_coerce_to_simple_array_type (type);
334 fprintf_filtered (stream, "array (");
338 fprintf_filtered (stream, _("<undecipherable array type>"));
343 if (ada_is_simple_array_type (type))
345 struct type *range_desc_type;
346 struct type *arr_type;
348 range_desc_type = ada_find_parallel_type (type, "___XA");
349 ada_fixup_array_indexes_type (range_desc_type);
352 if (range_desc_type == NULL)
354 for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
355 arr_type = TYPE_TARGET_TYPE (arr_type))
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);
368 n_indices = TYPE_NFIELDS (range_desc_type);
369 for (k = 0, arr_type = type;
371 k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
374 fprintf_filtered (stream, ", ");
375 print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
377 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
378 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
386 for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
387 fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
390 fprintf_filtered (stream, ") of ");
392 ada_print_type (ada_array_element_type (type, n_indices), "", stream,
393 show == 0 ? 0 : show - 1, level + 1);
395 fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
398 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
399 STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
400 values. Return non-zero if the field is an encoding of
401 discriminant values, as in a standard variant record, and 0 if the
402 field is not so encoded (as happens with single-component variants
403 in types annotated with pragma Unchecked_Variant). */
406 print_choices (struct type *type, int field_num, struct ui_file *stream,
407 struct type *val_type)
411 const char *name = TYPE_FIELD_NAME (type, field_num);
415 /* Skip over leading 'V': NOTE soon to be obsolete. */
418 if (!ada_scan_number (name, 1, NULL, &p))
432 fprintf_filtered (stream, " =>");
438 fprintf_filtered (stream, " | ");
449 if (!ada_scan_number (name, p + 1, &W, &p))
451 ada_print_scalar (val_type, W, stream);
458 if (!ada_scan_number (name, p + 1, &L, &p)
459 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
461 ada_print_scalar (val_type, L, stream);
462 fprintf_filtered (stream, " .. ");
463 ada_print_scalar (val_type, U, stream);
467 fprintf_filtered (stream, "others");
474 fprintf_filtered (stream, "?? =>");
478 /* Assuming that field FIELD_NUM of TYPE represents variants whose
479 discriminant is contained in OUTER_TYPE, print its components on STREAM.
480 LEVEL is the recursion (indentation) level, in case any of the fields
481 themselves have nested structure, and SHOW is the number of levels of
482 internal structure to show (see ada_print_type). For this purpose,
483 fields nested in a variant part are taken to be at the same level as
484 the fields immediately outside the variant part. */
487 print_variant_clauses (struct type *type, int field_num,
488 struct type *outer_type, struct ui_file *stream,
492 struct type *var_type, *par_type;
493 struct type *discr_type;
495 var_type = TYPE_FIELD_TYPE (type, field_num);
496 discr_type = ada_variant_discrim_type (var_type, outer_type);
498 if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
500 var_type = TYPE_TARGET_TYPE (var_type);
501 if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
505 par_type = ada_find_parallel_type (var_type, "___XVU");
506 if (par_type != NULL)
509 for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
511 fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
512 if (print_choices (var_type, i, stream, discr_type))
514 if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
515 outer_type, stream, show, level + 4)
517 fprintf_filtered (stream, " null;");
520 print_selected_record_field_types (var_type, outer_type, i, i,
521 stream, show, level + 4);
525 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
526 discriminants are contained in OUTER_TYPE, print a description of it
527 on STREAM. LEVEL is the recursion (indentation) level, in case any of
528 the fields themselves have nested structure, and SHOW is the number of
529 levels of internal structure to show (see ada_print_type). For this
530 purpose, fields nested in a variant part are taken to be at the same
531 level as the fields immediately outside the variant part. */
534 print_variant_part (struct type *type, int field_num, struct type *outer_type,
535 struct ui_file *stream, int show, int level)
537 fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
538 ada_variant_discrim_name
539 (TYPE_FIELD_TYPE (type, field_num)));
540 print_variant_clauses (type, field_num, outer_type, stream, show,
542 fprintf_filtered (stream, "\n%*send case;", level + 4, "");
545 /* Print a description on STREAM of the fields FLD0 through FLD1 in
546 record or union type TYPE, whose discriminants are in OUTER_TYPE.
547 LEVEL is the recursion (indentation) level, in case any of the
548 fields themselves have nested structure, and SHOW is the number of
549 levels of internal structure to show (see ada_print_type). Does
550 not print parent type information of TYPE. Returns 0 if no fields
551 printed, -1 for an incomplete type, else > 0. Prints each field
552 beginning on a new line, but does not put a new line at end. */
555 print_selected_record_field_types (struct type *type, struct type *outer_type,
557 struct ui_file *stream, int show, int level)
563 if (fld0 > fld1 && TYPE_STUB (type))
566 for (i = fld0; i <= fld1; i += 1)
570 if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
572 else if (ada_is_wrapper_field (type, i))
573 flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
574 stream, show, level);
575 else if (ada_is_variant_part (type, i))
577 print_variant_part (type, i, outer_type, stream, show, level);
583 fprintf_filtered (stream, "\n%*s", level + 4, "");
584 ada_print_type (TYPE_FIELD_TYPE (type, i),
585 TYPE_FIELD_NAME (type, i),
586 stream, show - 1, level + 4);
587 fprintf_filtered (stream, ";");
594 /* Print a description on STREAM of all fields of record or union type
595 TYPE, as for print_selected_record_field_types, above. */
598 print_record_field_types (struct type *type, struct type *outer_type,
599 struct ui_file *stream, int show, int level)
601 return print_selected_record_field_types (type, outer_type,
602 0, TYPE_NFIELDS (type) - 1,
603 stream, show, level);
607 /* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
608 level, in case the element type itself has nested structure, and SHOW is
609 the number of levels of internal structure to show (see ada_print_type). */
612 print_record_type (struct type *type0, struct ui_file *stream, int show,
615 struct type *parent_type;
618 type = ada_find_parallel_type (type0, "___XVE");
622 parent_type = ada_parent_type (type);
623 if (ada_type_name (parent_type) != NULL)
624 fprintf_filtered (stream, "new %s with record",
625 decoded_type_name (parent_type));
626 else if (parent_type == NULL && ada_is_tagged_type (type, 0))
627 fprintf_filtered (stream, "tagged record");
629 fprintf_filtered (stream, "record");
632 fprintf_filtered (stream, " ... end record");
638 if (parent_type != NULL && ada_type_name (parent_type) == NULL)
639 flds += print_record_field_types (parent_type, parent_type,
640 stream, show, level);
641 flds += print_record_field_types (type, type, stream, show, level);
644 fprintf_filtered (stream, "\n%*send record", level, "");
646 fprintf_filtered (stream, _(" <incomplete type> end record"));
648 fprintf_filtered (stream, " null; end record");
652 /* Print the unchecked union type TYPE in something resembling Ada
653 format on STREAM. LEVEL is the recursion (indentation) level
654 in case the element type itself has nested structure, and SHOW is the
655 number of levels of internal structure to show (see ada_print_type). */
657 print_unchecked_union_type (struct type *type, struct ui_file *stream,
661 fprintf_filtered (stream, "record (?) is ... end record");
662 else if (TYPE_NFIELDS (type) == 0)
663 fprintf_filtered (stream, "record (?) is null; end record");
668 fprintf_filtered (stream, "record (?) is\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, const 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, const char *varstring,
742 struct ui_file *stream, int show, int level)
744 struct type *type = ada_check_typedef (ada_get_base_type (type0));
745 char *type_name = decoded_type_name (type0);
746 int is_var_decl = (varstring != NULL && varstring[0] != '\0');
751 fprintf_filtered (stream, "%.*s: ",
752 ada_name_prefix_len (varstring), varstring);
753 fprintf_filtered (stream, "<null type?>");
758 type = ada_check_typedef (type);
760 if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
761 fprintf_filtered (stream, "%.*s: ",
762 ada_name_prefix_len (varstring), varstring);
764 if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
766 fprintf_filtered (stream, "%.*s",
767 ada_name_prefix_len (type_name), type_name);
771 if (ada_is_aligner_type (type))
772 ada_print_type (ada_aligned_type (type), "", stream, show, level);
773 else if (ada_is_constrained_packed_array_type (type)
774 && TYPE_CODE (type) != TYPE_CODE_PTR)
775 print_array_type (type, stream, show, level);
777 switch (TYPE_CODE (type))
780 fprintf_filtered (stream, "<");
781 c_print_type (type, "", stream, show, level);
782 fprintf_filtered (stream, ">");
785 case TYPE_CODE_TYPEDEF:
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 fprintf_filtered (stream, "(false, true)");
800 if (ada_is_fixed_point_type (type))
801 print_fixed_point_type (type, stream);
804 char *name = ada_type_name (type);
806 if (!ada_is_range_type_name (name))
807 fprintf_filtered (stream, _("<%d-byte integer>"),
811 fprintf_filtered (stream, "range ");
812 print_range_type (type, stream);
816 case TYPE_CODE_RANGE:
817 if (ada_is_fixed_point_type (type))
818 print_fixed_point_type (type, stream);
819 else if (ada_is_modular_type (type))
820 fprintf_filtered (stream, "mod %s",
821 int_string (ada_modulus (type), 10, 0, 0, 1));
824 fprintf_filtered (stream, "range ");
825 print_range (type, stream);
829 fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
833 fprintf_filtered (stream, "(...)");
835 print_enum_type (type, stream);
837 case TYPE_CODE_STRUCT:
838 if (ada_is_array_descriptor_type (type))
839 print_array_type (type, stream, show, level);
840 else if (ada_is_bogus_array_descriptor (type))
841 fprintf_filtered (stream,
842 _("array (?) of ? (<mal-formed descriptor>)"));
844 print_record_type (type, stream, show, level);
846 case TYPE_CODE_UNION:
847 print_unchecked_union_type (type, stream, show, level);
850 print_func_type (type, stream, varstring);
855 /* Implement the la_print_typedef language method for Ada. */
858 ada_print_typedef (struct type *type, struct symbol *new_symbol,
859 struct ui_file *stream)
861 type = ada_check_typedef (type);
862 ada_print_type (type, "", stream, 0, 0);
863 fprintf_filtered (stream, "\n");