1 /* Support for printing Ada types for GDB, the GNU debugger.
2 Copyright (C) 1986, 1988-1989, 1991, 1997-2004, 2007-2012 Free
3 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
)
625 const char *parent_name
= decoded_type_name (parent_type
);
627 /* If we fail to decode the parent type name, then use the parent
628 type name as is. Not pretty, but should never happen except
629 when the debugging info is incomplete or incorrect. This
630 prevents a crash trying to print a NULL pointer. */
631 if (parent_name
== NULL
)
632 parent_name
= ada_type_name (parent_type
);
633 fprintf_filtered (stream
, "new %s with record", parent_name
);
635 else if (parent_type
== NULL
&& ada_is_tagged_type (type
, 0))
636 fprintf_filtered (stream
, "tagged record");
638 fprintf_filtered (stream
, "record");
641 fprintf_filtered (stream
, " ... end record");
647 if (parent_type
!= NULL
&& ada_type_name (parent_type
) == NULL
)
648 flds
+= print_record_field_types (parent_type
, parent_type
,
649 stream
, show
, level
);
650 flds
+= print_record_field_types (type
, type
, stream
, show
, level
);
653 fprintf_filtered (stream
, "\n%*send record", level
, "");
655 fprintf_filtered (stream
, _(" <incomplete type> end record"));
657 fprintf_filtered (stream
, " null; end record");
661 /* Print the unchecked union type TYPE in something resembling Ada
662 format on STREAM. LEVEL is the recursion (indentation) level
663 in case the element type itself has nested structure, and SHOW is the
664 number of levels of internal structure to show (see ada_print_type). */
666 print_unchecked_union_type (struct type
*type
, struct ui_file
*stream
,
670 fprintf_filtered (stream
, "record (?) is ... end record");
671 else if (TYPE_NFIELDS (type
) == 0)
672 fprintf_filtered (stream
, "record (?) is null; end record");
677 fprintf_filtered (stream
, "record (?) is\n%*scase ? is", level
+ 4, "");
679 for (i
= 0; i
< TYPE_NFIELDS (type
); i
+= 1)
681 fprintf_filtered (stream
, "\n%*swhen ? =>\n%*s", level
+ 8, "",
683 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
684 TYPE_FIELD_NAME (type
, i
),
685 stream
, show
- 1, level
+ 12);
686 fprintf_filtered (stream
, ";");
689 fprintf_filtered (stream
, "\n%*send case;\n%*send record",
690 level
+ 4, "", level
, "");
696 /* Print function or procedure type TYPE on STREAM. Make it a header
697 for function or procedure NAME if NAME is not null. */
700 print_func_type (struct type
*type
, struct ui_file
*stream
, const char *name
)
702 int i
, len
= TYPE_NFIELDS (type
);
704 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
)
705 fprintf_filtered (stream
, "procedure");
707 fprintf_filtered (stream
, "function");
709 if (name
!= NULL
&& name
[0] != '\0')
710 fprintf_filtered (stream
, " %s", name
);
714 fprintf_filtered (stream
, " (");
715 for (i
= 0; i
< len
; i
+= 1)
719 fputs_filtered ("; ", stream
);
722 fprintf_filtered (stream
, "a%d: ", i
+ 1);
723 ada_print_type (TYPE_FIELD_TYPE (type
, i
), "", stream
, -1, 0);
725 fprintf_filtered (stream
, ")");
728 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
730 fprintf_filtered (stream
, " return ");
731 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, 0, 0);
736 /* Print a description of a type TYPE0.
737 Output goes to STREAM (via stdio).
738 If VARSTRING is a non-empty string, print as an Ada variable/field
740 SHOW+1 is the maximum number of levels of internal type structure
741 to show (this applies to record types, enumerated types, and
743 SHOW is the number of levels of internal type structure to show
744 when there is a type name for the SHOWth deepest level (0th is
746 When SHOW<0, no inner structure is shown.
747 LEVEL indicates level of recursion (for nested definitions). */
750 ada_print_type (struct type
*type0
, const char *varstring
,
751 struct ui_file
*stream
, int show
, int level
)
753 struct type
*type
= ada_check_typedef (ada_get_base_type (type0
));
754 char *type_name
= decoded_type_name (type0
);
755 int is_var_decl
= (varstring
!= NULL
&& varstring
[0] != '\0');
760 fprintf_filtered (stream
, "%.*s: ",
761 ada_name_prefix_len (varstring
), varstring
);
762 fprintf_filtered (stream
, "<null type?>");
767 type
= ada_check_typedef (type
);
769 if (is_var_decl
&& TYPE_CODE (type
) != TYPE_CODE_FUNC
)
770 fprintf_filtered (stream
, "%.*s: ",
771 ada_name_prefix_len (varstring
), varstring
);
773 if (type_name
!= NULL
&& show
<= 0 && !ada_is_aligner_type (type
))
775 fprintf_filtered (stream
, "%.*s",
776 ada_name_prefix_len (type_name
), type_name
);
780 if (ada_is_aligner_type (type
))
781 ada_print_type (ada_aligned_type (type
), "", stream
, show
, level
);
782 else if (ada_is_constrained_packed_array_type (type
)
783 && TYPE_CODE (type
) != TYPE_CODE_PTR
)
784 print_array_type (type
, stream
, show
, level
);
786 switch (TYPE_CODE (type
))
789 fprintf_filtered (stream
, "<");
790 c_print_type (type
, "", stream
, show
, level
);
791 fprintf_filtered (stream
, ">");
794 case TYPE_CODE_TYPEDEF
:
795 fprintf_filtered (stream
, "access ");
796 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
);
799 fprintf_filtered (stream
, "<ref> ");
800 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
);
802 case TYPE_CODE_ARRAY
:
803 print_array_type (type
, stream
, show
, level
);
806 fprintf_filtered (stream
, "(false, true)");
809 if (ada_is_fixed_point_type (type
))
810 print_fixed_point_type (type
, stream
);
813 char *name
= ada_type_name (type
);
815 if (!ada_is_range_type_name (name
))
816 fprintf_filtered (stream
, _("<%d-byte integer>"),
820 fprintf_filtered (stream
, "range ");
821 print_range_type (type
, stream
);
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_modular_type (type
))
829 fprintf_filtered (stream
, "mod %s",
830 int_string (ada_modulus (type
), 10, 0, 0, 1));
833 fprintf_filtered (stream
, "range ");
834 print_range (type
, stream
);
838 fprintf_filtered (stream
, _("<%d-byte float>"), TYPE_LENGTH (type
));
842 fprintf_filtered (stream
, "(...)");
844 print_enum_type (type
, stream
);
846 case TYPE_CODE_STRUCT
:
847 if (ada_is_array_descriptor_type (type
))
848 print_array_type (type
, stream
, show
, level
);
849 else if (ada_is_bogus_array_descriptor (type
))
850 fprintf_filtered (stream
,
851 _("array (?) of ? (<mal-formed descriptor>)"));
853 print_record_type (type
, stream
, show
, level
);
855 case TYPE_CODE_UNION
:
856 print_unchecked_union_type (type
, stream
, show
, level
);
859 print_func_type (type
, stream
, varstring
);
864 /* Implement the la_print_typedef language method for Ada. */
867 ada_print_typedef (struct type
*type
, struct symbol
*new_symbol
,
868 struct ui_file
*stream
)
870 type
= ada_check_typedef (type
);
871 ada_print_type (type
, "", stream
, 0, 0);
872 fprintf_filtered (stream
, "\n");
This page took 0.047772 seconds and 4 git commands to generate.