1 /* Support for printing Ada types for GDB, the GNU debugger.
2 Copyright 1986, 1988, 1989, 1991, 1997 Free Software Foundation, Inc.
4 This file is part of GDB.
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
21 #include "gdb_obstack.h"
22 #include "bfd.h" /* Binary File Description */
25 #include "expression.h"
34 #include "typeprint.h"
41 static int print_record_field_types (struct type
*, struct type
*,
42 struct ui_file
*, int, int);
44 static void print_array_type (struct type
*, struct ui_file
*, int, int);
46 static void print_choices (struct type
*, int, struct ui_file
*,
49 static void print_range (struct type
*, struct ui_file
*);
51 static void print_range_bound (struct type
*, char *, int *,
55 print_dynamic_range_bound (struct type
*, const char *, int,
56 const char *, struct ui_file
*);
58 static void print_range_type_named (char *, struct ui_file
*);
62 static char *name_buffer
;
63 static int name_buffer_len
;
65 /* The (demangled) Ada name of TYPE. This value persists until the
69 demangled_type_name (struct type
*type
)
71 if (ada_type_name (type
) == NULL
)
75 char *raw_name
= ada_type_name (type
);
78 if (name_buffer
== NULL
|| name_buffer_len
<= strlen (raw_name
))
80 name_buffer_len
= 16 + 2 * strlen (raw_name
);
81 name_buffer
= xrealloc (name_buffer
, name_buffer_len
);
83 strcpy (name_buffer
, raw_name
);
85 s
= (char *) strstr (name_buffer
, "___");
89 s
= name_buffer
+ strlen (name_buffer
) - 1;
90 while (s
> name_buffer
&& (s
[0] != '_' || s
[-1] != '_'))
99 for (s
= q
= name_buffer
; *s
!= '\0'; q
+= 1)
101 if (s
[0] == '_' && s
[1] == '_')
118 /* Print a description of a type in the format of a
119 typedef for the current language.
120 NEW is the new name for a type TYPE. */
123 ada_typedef_print (struct type
*type
, struct symbol
*new,
124 struct ui_file
*stream
)
126 fprintf_filtered (stream
, "type %.*s is ",
127 ada_name_prefix_len (SYMBOL_SOURCE_NAME (new)),
128 SYMBOL_SOURCE_NAME (new));
129 type_print (type
, "", stream
, 1);
132 /* Print range type TYPE on STREAM. */
135 print_range (struct type
*type
, struct ui_file
*stream
)
137 struct type
*target_type
;
138 target_type
= TYPE_TARGET_TYPE (type
);
139 if (target_type
== NULL
)
142 switch (TYPE_CODE (target_type
))
144 case TYPE_CODE_RANGE
:
151 target_type
= builtin_type_ada_int
;
155 if (TYPE_NFIELDS (type
) < 2)
157 /* A range needs at least 2 bounds to be printed. If there are less
158 than 2, just print the type name instead of the range itself.
159 This check handles cases such as characters, for example.
161 Note that if the name is not defined, then we don't print anything.
163 fprintf_filtered (stream
, "%.*s",
164 ada_name_prefix_len (TYPE_NAME (type
)),
169 /* We extract the range type bounds respectively from the first element
170 and the last element of the type->fields array */
171 const LONGEST lower_bound
= (LONGEST
) TYPE_LOW_BOUND (type
);
172 const LONGEST upper_bound
=
173 (LONGEST
) TYPE_FIELD_BITPOS (type
, TYPE_NFIELDS (type
) - 1);
175 ada_print_scalar (target_type
, lower_bound
, stream
);
176 fprintf_filtered (stream
, " .. ");
177 ada_print_scalar (target_type
, upper_bound
, stream
);
181 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
182 set *N past the bound and its delimiter, if any. */
185 print_range_bound (struct type
*type
, char *bounds
, int *n
,
186 struct ui_file
*stream
)
189 if (ada_scan_number (bounds
, *n
, &B
, n
))
191 ada_print_scalar (type
, B
, stream
);
192 if (bounds
[*n
] == '_')
198 char *bound
= bounds
+ *n
;
201 pend
= strstr (bound
, "__");
203 *n
+= bound_len
= strlen (bound
);
206 bound_len
= pend
- bound
;
209 fprintf_filtered (stream
, "%.*s", bound_len
, bound
);
213 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
214 the value (if found) of the bound indicated by SUFFIX ("___L" or
215 "___U") according to the ___XD conventions. */
218 print_dynamic_range_bound (struct type
*type
, const char *name
, int name_len
,
219 const char *suffix
, struct ui_file
*stream
)
221 static char *name_buf
= NULL
;
222 static size_t name_buf_len
= 0;
226 GROW_VECT (name_buf
, name_buf_len
, name_len
+ strlen (suffix
) + 1);
227 strncpy (name_buf
, name
, name_len
);
228 strcpy (name_buf
+ name_len
, suffix
);
230 B
= get_int_var_value (name_buf
, 0, &OK
);
232 ada_print_scalar (type
, B
, stream
);
234 fprintf_filtered (stream
, "?");
237 /* Print the range type named NAME. */
240 print_range_type_named (char *name
, struct ui_file
*stream
)
242 struct type
*raw_type
= ada_find_any_type (name
);
243 struct type
*base_type
;
247 if (raw_type
== NULL
)
248 base_type
= builtin_type_int
;
249 else if (TYPE_CODE (raw_type
) == TYPE_CODE_RANGE
)
250 base_type
= TYPE_TARGET_TYPE (raw_type
);
252 base_type
= raw_type
;
254 subtype_info
= strstr (name
, "___XD");
255 if (subtype_info
== NULL
&& raw_type
== NULL
)
256 fprintf_filtered (stream
, "? .. ?");
257 else if (subtype_info
== NULL
)
258 print_range (raw_type
, stream
);
261 int prefix_len
= subtype_info
- name
;
266 bounds_str
= strchr (subtype_info
, '_');
269 if (*subtype_info
== 'L')
271 print_range_bound (raw_type
, bounds_str
, &n
, stream
);
275 print_dynamic_range_bound (raw_type
, name
, prefix_len
, "___L",
278 fprintf_filtered (stream
, " .. ");
280 if (*subtype_info
== 'U')
281 print_range_bound (raw_type
, bounds_str
, &n
, stream
);
283 print_dynamic_range_bound (raw_type
, name
, prefix_len
, "___U",
288 /* Print enumerated type TYPE on STREAM. */
291 print_enum_type (struct type
*type
, struct ui_file
*stream
)
293 int len
= TYPE_NFIELDS (type
);
296 fprintf_filtered (stream
, "(");
300 for (i
= 0; i
< len
; i
++)
304 fprintf_filtered (stream
, ", ");
306 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type
, i
)), stream
);
307 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
309 fprintf_filtered (stream
, " => %d", TYPE_FIELD_BITPOS (type
, i
));
310 lastval
= TYPE_FIELD_BITPOS (type
, i
);
314 fprintf_filtered (stream
, ")");
317 /* Print representation of Ada fixed-point type TYPE on STREAM. */
320 print_fixed_point_type (struct type
*type
, struct ui_file
*stream
)
322 DOUBLEST delta
= ada_delta (type
);
323 DOUBLEST small
= ada_fixed_to_float (type
, 1.0);
326 fprintf_filtered (stream
, "delta ??");
329 fprintf_filtered (stream
, "delta %g", (double) delta
);
331 fprintf_filtered (stream
, " <'small = %g>", (double) small
);
335 /* Print representation of special VAX floating-point type TYPE on STREAM. */
338 print_vax_floating_point_type (struct type
*type
, struct ui_file
*stream
)
340 fprintf_filtered (stream
, "<float format %c>",
341 ada_vax_float_type_suffix (type
));
344 /* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
345 recursion (indentation) level, in case the element type itself has
346 nested structure, and SHOW is the number of levels of internal
347 structure to show (see ada_print_type). */
350 print_array_type (struct type
*type
, struct ui_file
*stream
, int show
,
357 fprintf_filtered (stream
, "array (");
361 fprintf_filtered (stream
, "...");
364 if (ada_is_packed_array_type (type
))
365 type
= ada_coerce_to_simple_array_type (type
);
366 if (ada_is_simple_array (type
))
368 struct type
*range_desc_type
=
369 ada_find_parallel_type (type
, "___XA");
370 struct type
*arr_type
;
373 if (range_desc_type
== NULL
)
375 for (arr_type
= type
; TYPE_CODE (arr_type
) == TYPE_CODE_ARRAY
;
376 arr_type
= TYPE_TARGET_TYPE (arr_type
))
378 if (arr_type
!= type
)
379 fprintf_filtered (stream
, ", ");
380 print_range (TYPE_INDEX_TYPE (arr_type
), stream
);
381 if (TYPE_FIELD_BITSIZE (arr_type
, 0) > 0)
382 bitsize
= TYPE_FIELD_BITSIZE (arr_type
, 0);
388 n_indices
= TYPE_NFIELDS (range_desc_type
);
389 for (k
= 0, arr_type
= type
;
391 k
+= 1, arr_type
= TYPE_TARGET_TYPE (arr_type
))
394 fprintf_filtered (stream
, ", ");
395 print_range_type_named (TYPE_FIELD_NAME
396 (range_desc_type
, k
), stream
);
397 if (TYPE_FIELD_BITSIZE (arr_type
, 0) > 0)
398 bitsize
= TYPE_FIELD_BITSIZE (arr_type
, 0);
405 for (i
= i0
= ada_array_arity (type
); i
> 0; i
-= 1)
406 fprintf_filtered (stream
, "%s<>", i
== i0
? "" : ", ");
410 fprintf_filtered (stream
, ") of ");
412 ada_print_type (ada_array_element_type (type
, n_indices
), "", stream
,
413 show
== 0 ? 0 : show
- 1, level
+ 1);
415 fprintf_filtered (stream
, " <packed: %d-bit elements>", bitsize
);
418 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
419 STREAM, assuming the VAL_TYPE is the type of the values. */
422 print_choices (struct type
*type
, int field_num
, struct ui_file
*stream
,
423 struct type
*val_type
)
427 const char *name
= TYPE_FIELD_NAME (type
, field_num
);
431 /* Skip over leading 'V': NOTE soon to be obsolete. */
434 if (!ada_scan_number (name
, 1, NULL
, &p
))
450 fprintf_filtered (stream
, " | ");
460 if (!ada_scan_number (name
, p
+ 1, &W
, &p
))
462 ada_print_scalar (val_type
, W
, stream
);
468 if (!ada_scan_number (name
, p
+ 1, &L
, &p
)
469 || name
[p
] != 'T' || !ada_scan_number (name
, p
+ 1, &U
, &p
))
471 ada_print_scalar (val_type
, L
, stream
);
472 fprintf_filtered (stream
, " .. ");
473 ada_print_scalar (val_type
, U
, stream
);
477 fprintf_filtered (stream
, "others");
484 fprintf_filtered (stream
, "??");
488 /* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
489 discriminant is contained in OUTER_TYPE, print its variants on STREAM.
490 LEVEL is the recursion
491 (indentation) level, in case any of the fields themselves have
492 nested structure, and SHOW is the number of levels of internal structure
493 to show (see ada_print_type). For this purpose, fields nested in a
494 variant part are taken to be at the same level as the fields
495 immediately outside the variant part. */
498 print_variant_clauses (struct type
*type
, int field_num
,
499 struct type
*outer_type
, struct ui_file
*stream
,
503 struct type
*var_type
;
504 struct type
*discr_type
;
506 var_type
= TYPE_FIELD_TYPE (type
, field_num
);
507 discr_type
= ada_variant_discrim_type (var_type
, outer_type
);
509 if (TYPE_CODE (var_type
) == TYPE_CODE_PTR
)
511 var_type
= TYPE_TARGET_TYPE (var_type
);
512 if (TYPE_FLAGS (var_type
) & TYPE_FLAG_STUB
)
514 var_type
= ada_find_parallel_type (var_type
, "___XVU");
515 if (var_type
== NULL
)
520 for (i
= 0; i
< TYPE_NFIELDS (var_type
); i
+= 1)
522 fprintf_filtered (stream
, "\n%*swhen ", level
+ 4, "");
523 print_choices (var_type
, i
, stream
, discr_type
);
524 fprintf_filtered (stream
, " =>");
525 if (print_record_field_types (TYPE_FIELD_TYPE (var_type
, i
),
526 outer_type
, stream
, show
, level
+ 4) <= 0)
527 fprintf_filtered (stream
, " null;");
531 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
532 discriminants are contained in OUTER_TYPE, print a description of it
533 on STREAM. LEVEL is the recursion (indentation) level, in case any of
534 the fields themselves have nested structure, and SHOW is the number of
535 levels of internal structure to show (see ada_print_type). For this
536 purpose, fields nested in a variant part are taken to be at the same
537 level as the fields immediately outside the variant part. */
540 print_variant_part (struct type
*type
, int field_num
, struct type
*outer_type
,
541 struct ui_file
*stream
, int show
, int level
)
543 fprintf_filtered (stream
, "\n%*scase %s is", level
+ 4, "",
544 ada_variant_discrim_name
545 (TYPE_FIELD_TYPE (type
, field_num
)));
546 print_variant_clauses (type
, field_num
, outer_type
, stream
, show
,
548 fprintf_filtered (stream
, "\n%*send case;", level
+ 4, "");
551 /* Print a description on STREAM of the fields in record type TYPE, whose
552 discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
553 level, in case any of the fields themselves have nested structure,
554 and SHOW is the number of levels of internal structure to show
555 (see ada_print_type). Does not print parent type information of TYPE.
556 Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
557 Prints each field beginning on a new line, but does not put a new line at
561 print_record_field_types (struct type
*type
, struct type
*outer_type
,
562 struct ui_file
*stream
, int show
, int level
)
567 len
= TYPE_NFIELDS (type
);
569 if (len
== 0 && (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
) != 0)
572 for (i
= 0; i
< len
; i
+= 1)
576 if (ada_is_parent_field (type
, i
) || ada_is_ignored_field (type
, i
))
578 else if (ada_is_wrapper_field (type
, i
))
579 flds
+= print_record_field_types (TYPE_FIELD_TYPE (type
, i
), type
,
580 stream
, show
, level
);
581 else if (ada_is_variant_part (type
, i
))
583 print_variant_part (type
, i
, outer_type
, stream
, show
, level
);
589 fprintf_filtered (stream
, "\n%*s", level
+ 4, "");
590 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
591 TYPE_FIELD_NAME (type
, i
),
592 stream
, show
- 1, level
+ 4);
593 fprintf_filtered (stream
, ";");
600 /* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
601 level, in case the element type itself has nested structure, and SHOW is
602 the number of levels of internal structure to show (see ada_print_type). */
605 print_record_type (struct type
*type0
, struct ui_file
*stream
, int show
,
608 struct type
*parent_type
;
612 if (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
)
614 struct type
*type1
= ada_find_parallel_type (type
, "___XVE");
619 parent_type
= ada_parent_type (type
);
620 if (ada_type_name (parent_type
) != NULL
)
621 fprintf_filtered (stream
, "new %s with ",
622 demangled_type_name (parent_type
));
623 else if (parent_type
== NULL
&& ada_is_tagged_type (type
))
624 fprintf_filtered (stream
, "tagged ");
626 fprintf_filtered (stream
, "record");
629 fprintf_filtered (stream
, " ... end record");
635 if (parent_type
!= NULL
&& ada_type_name (parent_type
) == NULL
)
636 flds
+= print_record_field_types (parent_type
, parent_type
,
637 stream
, show
, level
);
638 flds
+= print_record_field_types (type
, type
, stream
, show
, level
);
641 fprintf_filtered (stream
, "\n%*send record", level
, "");
643 fprintf_filtered (stream
, " <incomplete type> end record");
645 fprintf_filtered (stream
, " null; end record");
649 /* Print the unchecked union type TYPE in something resembling Ada
650 format on STREAM. LEVEL is the recursion (indentation) level
651 in case the element type itself has nested structure, and SHOW is the
652 number of levels of internal structure to show (see ada_print_type). */
654 print_unchecked_union_type (struct type
*type
, struct ui_file
*stream
,
657 fprintf_filtered (stream
, "record (?) is");
660 fprintf_filtered (stream
, " ... end record");
661 else if (TYPE_NFIELDS (type
) == 0)
662 fprintf_filtered (stream
, " null; end record");
667 fprintf_filtered (stream
, "\n%*scase ? is", level
+ 4, "");
669 for (i
= 0; i
< TYPE_NFIELDS (type
); i
+= 1)
671 fprintf_filtered (stream
, "\n%*swhen ? =>\n%*s", level
+ 8, "",
673 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
674 TYPE_FIELD_NAME (type
, i
),
675 stream
, show
- 1, level
+ 12);
676 fprintf_filtered (stream
, ";");
679 fprintf_filtered (stream
, "\n%*send case;\n%*send record",
680 level
+ 4, "", level
, "");
686 /* Print function or procedure type TYPE on STREAM. Make it a header
687 for function or procedure NAME if NAME is not null. */
690 print_func_type (struct type
*type
, struct ui_file
*stream
, char *name
)
692 int i
, len
= TYPE_NFIELDS (type
);
694 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
)
695 fprintf_filtered (stream
, "procedure");
697 fprintf_filtered (stream
, "function");
699 if (name
!= NULL
&& name
[0] != '\0')
700 fprintf_filtered (stream
, " %s", name
);
704 fprintf_filtered (stream
, " (");
705 for (i
= 0; i
< len
; i
+= 1)
709 fputs_filtered ("; ", stream
);
712 fprintf_filtered (stream
, "a%d: ", i
+ 1);
713 ada_print_type (TYPE_FIELD_TYPE (type
, i
), "", stream
, -1, 0);
715 fprintf_filtered (stream
, ")");
718 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
720 fprintf_filtered (stream
, " return ");
721 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, 0, 0);
726 /* Print a description of a type TYPE0.
727 Output goes to STREAM (via stdio).
728 If VARSTRING is a non-empty string, print as an Ada variable/field
730 SHOW+1 is the maximum number of levels of internal type structure
731 to show (this applies to record types, enumerated types, and
733 SHOW is the number of levels of internal type structure to show
734 when there is a type name for the SHOWth deepest level (0th is
736 When SHOW<0, no inner structure is shown.
737 LEVEL indicates level of recursion (for nested definitions). */
740 ada_print_type (struct type
*type0
, char *varstring
, struct ui_file
*stream
,
745 struct type
*type
= ada_completed_type (ada_get_base_type (type0
));
746 char *type_name
= demangled_type_name (type
);
747 int is_var_decl
= (varstring
!= NULL
&& varstring
[0] != '\0');
752 fprintf_filtered (stream
, "%.*s: ",
753 ada_name_prefix_len (varstring
), varstring
);
754 fprintf_filtered (stream
, "<null type?>");
759 CHECK_TYPEDEF (type
);
761 if (is_var_decl
&& TYPE_CODE (type
) != TYPE_CODE_FUNC
)
762 fprintf_filtered (stream
, "%.*s: ",
763 ada_name_prefix_len (varstring
), varstring
);
765 if (type_name
!= NULL
&& show
<= 0)
767 fprintf_filtered (stream
, "%.*s",
768 ada_name_prefix_len (type_name
), type_name
);
772 if (ada_is_aligner_type (type
))
773 ada_print_type (ada_aligned_type (type
), "", stream
, show
, level
);
774 else if (ada_is_packed_array_type (type
))
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 fprintf_filtered (stream
, "access ");
786 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
);
789 fprintf_filtered (stream
, "<ref> ");
790 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
, level
);
792 case TYPE_CODE_ARRAY
:
793 print_array_type (type
, stream
, show
, level
);
796 if (ada_is_fixed_point_type (type
))
797 print_fixed_point_type (type
, stream
);
798 else if (ada_is_vax_floating_type (type
))
799 print_vax_floating_point_type (type
, stream
);
802 char *name
= ada_type_name (type
);
803 if (!ada_is_range_type_name (name
))
804 fprintf_filtered (stream
, "<%d-byte integer>",
808 fprintf_filtered (stream
, "range ");
809 print_range_type_named (name
, stream
);
813 case TYPE_CODE_RANGE
:
814 if (ada_is_fixed_point_type (type
))
815 print_fixed_point_type (type
, stream
);
816 else if (ada_is_vax_floating_type (type
))
817 print_vax_floating_point_type (type
, stream
);
818 else if (ada_is_modular_type (type
))
819 fprintf_filtered (stream
, "mod %ld", (long) ada_modulus (type
));
822 fprintf_filtered (stream
, "range ");
823 print_range (type
, stream
);
827 fprintf_filtered (stream
, "<%d-byte float>", TYPE_LENGTH (type
));
831 fprintf_filtered (stream
, "(...)");
833 print_enum_type (type
, stream
);
835 case TYPE_CODE_STRUCT
:
836 if (ada_is_array_descriptor (type
))
837 print_array_type (type
, stream
, show
, level
);
838 else if (ada_is_bogus_array_descriptor (type
))
839 fprintf_filtered (stream
,
840 "array (?) of ? (<mal-formed descriptor>)");
842 print_record_type (type
, stream
, show
, level
);
844 case TYPE_CODE_UNION
:
845 print_unchecked_union_type (type
, stream
, show
, level
);
848 print_func_type (type
, stream
, varstring
);
This page took 0.049596 seconds and 4 git commands to generate.