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
*, struct type
*);
48 static void print_range (struct type
*, struct ui_file
*);
50 static void print_range_bound (struct type
*, char*, int*, struct ui_file
*);
53 print_dynamic_range_bound (struct type
*, const char*, int,
54 const char*, struct ui_file
*);
56 static void print_range_type_named (char*, struct ui_file
*);
60 static char* name_buffer
;
61 static int name_buffer_len
;
63 /* The (demangled) Ada name of TYPE. This value persists until the
67 demangled_type_name (struct type
*type
)
69 if (ada_type_name (type
) == NULL
)
73 char* raw_name
= ada_type_name (type
);
76 if (name_buffer
== NULL
|| name_buffer_len
<= strlen (raw_name
))
78 name_buffer_len
= 16 + 2 * strlen (raw_name
);
79 name_buffer
= xrealloc (name_buffer
, name_buffer_len
);
81 strcpy (name_buffer
, raw_name
);
83 s
= (char*) strstr (name_buffer
, "___");
87 s
= name_buffer
+ strlen (name_buffer
) - 1;
88 while (s
> name_buffer
&& (s
[0] != '_' || s
[-1] != '_'))
97 for (s
= q
= name_buffer
; *s
!= '\0'; q
+= 1)
99 if (s
[0] == '_' && s
[1] == '_')
114 /* Print a description of a type in the format of a
115 typedef for the current language.
116 NEW is the new name for a type TYPE. */
119 ada_typedef_print (struct type
*type
, struct symbol
*new, struct ui_file
*stream
)
121 fprintf_filtered (stream
, "type %.*s is ",
122 ada_name_prefix_len (SYMBOL_SOURCE_NAME(new)),
123 SYMBOL_SOURCE_NAME(new));
124 type_print (type
, "", stream
, 1);
127 /* Print range type TYPE on STREAM. */
130 print_range (struct type
* type
, struct ui_file
* stream
)
132 struct type
* target_type
;
133 target_type
= TYPE_TARGET_TYPE (type
);
134 if (target_type
== NULL
)
137 switch (TYPE_CODE (target_type
))
139 case TYPE_CODE_RANGE
:
146 target_type
= builtin_type_ada_int
;
150 if (TYPE_NFIELDS (type
) < 2)
152 /* A range needs at least 2 bounds to be printed. If there are less
153 than 2, just print the type name instead of the range itself.
154 This check handles cases such as characters, for example.
156 Note that if the name is not defined, then we don't print anything.
158 fprintf_filtered (stream
, "%.*s",
159 ada_name_prefix_len (TYPE_NAME (type
)),
164 /* We extract the range type bounds respectively from the first element
165 and the last element of the type->fields array */
166 const LONGEST lower_bound
= (LONGEST
) TYPE_LOW_BOUND (type
);
167 const LONGEST upper_bound
=
168 (LONGEST
) TYPE_FIELD_BITPOS (type
, TYPE_NFIELDS (type
) -1);
170 ada_print_scalar (target_type
, lower_bound
, stream
);
171 fprintf_filtered (stream
, " .. ");
172 ada_print_scalar (target_type
, upper_bound
, stream
);
176 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
177 set *N past the bound and its delimiter, if any. */
180 print_range_bound (struct type
* type
, char* bounds
, int* n
, struct ui_file
* stream
)
183 if (ada_scan_number (bounds
, *n
, &B
, n
))
185 ada_print_scalar (type
, B
, stream
);
186 if (bounds
[*n
] == '_')
192 char* bound
= bounds
+ *n
;
195 pend
= strstr (bound
, "__");
197 *n
+= bound_len
= strlen (bound
);
200 bound_len
= pend
- bound
;
203 fprintf_filtered (stream
, "%.*s", bound_len
, bound
);
207 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
208 the value (if found) of the bound indicated by SUFFIX ("___L" or
209 "___U") according to the ___XD conventions. */
212 print_dynamic_range_bound (struct type
* type
, const char* name
, int name_len
, const char* suffix
, struct ui_file
* stream
)
214 static char *name_buf
= NULL
;
215 static size_t name_buf_len
= 0;
219 GROW_VECT (name_buf
, name_buf_len
, name_len
+ strlen (suffix
) + 1);
220 strncpy (name_buf
, name
, name_len
);
221 strcpy (name_buf
+ name_len
, suffix
);
223 B
= get_int_var_value (name_buf
, 0, &OK
);
225 ada_print_scalar (type
, B
, stream
);
227 fprintf_filtered (stream
, "?");
230 /* Print the range type named NAME. */
233 print_range_type_named (char* name
, struct ui_file
* stream
)
235 struct type
*raw_type
= ada_find_any_type (name
);
236 struct type
*base_type
;
240 if (raw_type
== NULL
)
241 base_type
= builtin_type_int
;
242 else if (TYPE_CODE (raw_type
) == TYPE_CODE_RANGE
)
243 base_type
= TYPE_TARGET_TYPE (raw_type
);
245 base_type
= raw_type
;
247 subtype_info
= strstr (name
, "___XD");
248 if (subtype_info
== NULL
&& raw_type
== NULL
)
249 fprintf_filtered (stream
, "? .. ?");
250 else if (subtype_info
== NULL
)
251 print_range (raw_type
, stream
);
254 int prefix_len
= subtype_info
- name
;
259 bounds_str
= strchr (subtype_info
, '_');
262 if (*subtype_info
== 'L')
264 print_range_bound (raw_type
, bounds_str
, &n
, stream
);
268 print_dynamic_range_bound (raw_type
, name
, prefix_len
, "___L", stream
);
270 fprintf_filtered (stream
, " .. ");
272 if (*subtype_info
== 'U')
273 print_range_bound (raw_type
, bounds_str
, &n
, stream
);
275 print_dynamic_range_bound (raw_type
, name
, prefix_len
, "___U", stream
);
279 /* Print enumerated type TYPE on STREAM. */
282 print_enum_type (struct type
*type
, struct ui_file
*stream
)
284 int len
= TYPE_NFIELDS (type
);
287 fprintf_filtered (stream
, "(");
291 for (i
= 0; i
< len
; i
++)
294 if (i
) fprintf_filtered (stream
, ", ");
296 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type
, i
)), stream
);
297 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
299 fprintf_filtered (stream
, " => %d", TYPE_FIELD_BITPOS (type
, i
));
300 lastval
= TYPE_FIELD_BITPOS (type
, i
);
304 fprintf_filtered (stream
, ")");
307 /* Print representation of Ada fixed-point type TYPE on STREAM. */
310 print_fixed_point_type (struct type
*type
, struct ui_file
*stream
)
312 DOUBLEST delta
= ada_delta (type
);
313 DOUBLEST small
= ada_fixed_to_float (type
, 1.0);
316 fprintf_filtered (stream
, "delta ??");
319 fprintf_filtered (stream
, "delta %g", (double) delta
);
321 fprintf_filtered (stream
, " <'small = %g>", (double) small
);
325 /* Print representation of special VAX floating-point type TYPE on STREAM. */
328 print_vax_floating_point_type (struct type
*type
, struct ui_file
*stream
)
330 fprintf_filtered (stream
, "<float format %c>",
331 ada_vax_float_type_suffix (type
));
334 /* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
335 recursion (indentation) level, in case the element type itself has
336 nested structure, and SHOW is the number of levels of internal
337 structure to show (see ada_print_type). */
340 print_array_type (struct type
*type
, struct ui_file
*stream
, int show
, int level
)
346 fprintf_filtered (stream
, "array (");
350 fprintf_filtered (stream
, "...");
353 if (ada_is_packed_array_type (type
))
354 type
= ada_coerce_to_simple_array_type (type
);
355 if (ada_is_simple_array (type
))
357 struct type
* range_desc_type
=
358 ada_find_parallel_type (type
, "___XA");
359 struct type
* arr_type
;
362 if (range_desc_type
== NULL
)
364 for (arr_type
= type
; TYPE_CODE (arr_type
) == TYPE_CODE_ARRAY
;
365 arr_type
= TYPE_TARGET_TYPE (arr_type
))
367 if (arr_type
!= type
)
368 fprintf_filtered (stream
, ", ");
369 print_range (TYPE_INDEX_TYPE (arr_type
), stream
);
370 if (TYPE_FIELD_BITSIZE (arr_type
, 0) > 0)
371 bitsize
= TYPE_FIELD_BITSIZE (arr_type
, 0);
377 n_indices
= TYPE_NFIELDS (range_desc_type
);
378 for (k
= 0, arr_type
= type
;
380 k
+= 1, arr_type
= TYPE_TARGET_TYPE (arr_type
))
383 fprintf_filtered (stream
, ", ");
384 print_range_type_named (TYPE_FIELD_NAME (range_desc_type
, k
),
386 if (TYPE_FIELD_BITSIZE (arr_type
, 0) > 0)
387 bitsize
= TYPE_FIELD_BITSIZE (arr_type
, 0);
394 for (i
= i0
= ada_array_arity (type
); i
> 0; i
-= 1)
395 fprintf_filtered (stream
, "%s<>", i
== i0
? "" : ", ");
399 fprintf_filtered (stream
, ") of ");
401 ada_print_type (ada_array_element_type (type
, n_indices
), "", stream
,
402 show
== 0 ? 0 : show
-1, level
+1);
404 fprintf_filtered (stream
, " <packed: %d-bit elements>", bitsize
);
407 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
408 STREAM, assuming the VAL_TYPE is the type of the values. */
411 print_choices (struct type
*type
, int field_num
, struct ui_file
*stream
, struct type
*val_type
)
415 const char* name
= TYPE_FIELD_NAME (type
, field_num
);
419 /* Skip over leading 'V': NOTE soon to be obsolete. */
422 if (! ada_scan_number (name
, 1, NULL
, &p
))
438 fprintf_filtered (stream
, " | ");
448 if (! ada_scan_number (name
, p
+ 1, &W
, &p
))
450 ada_print_scalar (val_type
, W
, stream
);
456 if (! ada_scan_number (name
, p
+ 1, &L
, &p
)
458 || ! ada_scan_number (name
, p
+ 1, &U
, &p
))
460 ada_print_scalar (val_type
, L
, stream
);
461 fprintf_filtered (stream
, " .. ");
462 ada_print_scalar (val_type
, U
, stream
);
466 fprintf_filtered (stream
, "others");
473 fprintf_filtered (stream
, "??");
477 /* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
478 discriminant is contained in OUTER_TYPE, print its variants on STREAM.
479 LEVEL is the recursion
480 (indentation) level, in case any of the fields themselves have
481 nested structure, and SHOW is the number of levels of internal structure
482 to show (see ada_print_type). For this purpose, fields nested in a
483 variant part are taken to be at the same level as the fields
484 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
;
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 (TYPE_FLAGS (var_type
) & TYPE_FLAG_STUB
)
503 var_type
= ada_find_parallel_type (var_type
, "___XVU");
504 if (var_type
== NULL
)
509 for (i
= 0; i
< TYPE_NFIELDS (var_type
); i
+= 1)
511 fprintf_filtered (stream
, "\n%*swhen ", level
+ 4, "");
512 print_choices (var_type
, i
, stream
, discr_type
);
513 fprintf_filtered (stream
, " =>");
514 if (print_record_field_types (TYPE_FIELD_TYPE (var_type
, i
),
515 outer_type
, stream
, show
, level
+4) <= 0)
516 fprintf_filtered (stream
, " null;");
520 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
521 discriminants are contained in OUTER_TYPE, print a description of it
522 on STREAM. LEVEL is the recursion (indentation) level, in case any of
523 the fields themselves have nested structure, and SHOW is the number of
524 levels of internal structure to show (see ada_print_type). For this
525 purpose, fields nested in a variant part are taken to be at the same
526 level as the fields immediately outside the variant part. */
529 print_variant_part (struct type
*type
, int field_num
, struct type
*outer_type
,
530 struct ui_file
*stream
, int show
, int level
)
532 fprintf_filtered (stream
, "\n%*scase %s is", level
+ 4, "",
533 ada_variant_discrim_name
534 (TYPE_FIELD_TYPE (type
, field_num
)));
535 print_variant_clauses (type
, field_num
, outer_type
, stream
, show
, level
+ 4);
536 fprintf_filtered (stream
, "\n%*send case;", level
+ 4, "");
539 /* Print a description on STREAM of the fields in record type TYPE, whose
540 discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
541 level, in case any of the fields themselves have nested structure,
542 and SHOW is the number of levels of internal structure to show
543 (see ada_print_type). Does not print parent type information of TYPE.
544 Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
545 Prints each field beginning on a new line, but does not put a new line at
549 print_record_field_types (struct type
*type
, struct type
*outer_type
,
550 struct ui_file
*stream
, int show
, int level
)
555 len
= TYPE_NFIELDS (type
);
557 if (len
== 0 && (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
) != 0)
560 for (i
= 0; i
< len
; i
+= 1)
564 if (ada_is_parent_field (type
, i
)
565 || ada_is_ignored_field (type
, i
))
567 else if (ada_is_wrapper_field (type
, i
))
568 flds
+= print_record_field_types (TYPE_FIELD_TYPE (type
, i
), type
,
569 stream
, show
, level
);
570 else if (ada_is_variant_part (type
, i
))
572 print_variant_part (type
, i
, outer_type
, stream
, show
, level
);
578 fprintf_filtered (stream
, "\n%*s", level
+ 4, "");
579 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
580 TYPE_FIELD_NAME (type
, i
),
581 stream
, show
- 1, level
+ 4);
582 fprintf_filtered (stream
, ";");
589 /* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
590 level, in case the element type itself has nested structure, and SHOW is
591 the number of levels of internal structure to show (see ada_print_type). */
594 print_record_type (struct type
* type0
, struct ui_file
* stream
, int show
, int level
)
596 struct type
* parent_type
;
600 if (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
)
602 struct type
* type1
= ada_find_parallel_type (type
, "___XVE");
607 parent_type
= ada_parent_type (type
);
608 if (ada_type_name (parent_type
) != NULL
)
609 fprintf_filtered (stream
, "new %s with ",
610 demangled_type_name (parent_type
));
611 else if (parent_type
== NULL
&& ada_is_tagged_type (type
))
612 fprintf_filtered (stream
, "tagged ");
614 fprintf_filtered (stream
, "record");
617 fprintf_filtered (stream
, " ... end record");
623 if (parent_type
!= NULL
&& ada_type_name (parent_type
) == NULL
)
624 flds
+= print_record_field_types (parent_type
, parent_type
,
625 stream
, show
, level
);
626 flds
+= print_record_field_types (type
, type
, stream
, show
, level
);
629 fprintf_filtered (stream
, "\n%*send record", level
, "");
631 fprintf_filtered (stream
, " <incomplete type> end record");
633 fprintf_filtered (stream
, " null; end record");
637 /* Print the unchecked union type TYPE in something resembling Ada
638 format on STREAM. LEVEL is the recursion (indentation) level
639 in case the element type itself has nested structure, and SHOW is the
640 number of levels of internal structure to show (see ada_print_type). */
642 print_unchecked_union_type (struct type
* type
, struct ui_file
* stream
,
645 fprintf_filtered (stream
, "record (?) is");
648 fprintf_filtered (stream
, " ... end record");
649 else if (TYPE_NFIELDS (type
) == 0)
650 fprintf_filtered (stream
, " null; end record");
655 fprintf_filtered (stream
, "\n%*scase ? is",
658 for (i
= 0; i
< TYPE_NFIELDS (type
); i
+= 1)
660 fprintf_filtered (stream
, "\n%*swhen ? =>\n%*s", level
+8, "",
662 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
663 TYPE_FIELD_NAME (type
, i
),
664 stream
, show
- 1, level
+ 12);
665 fprintf_filtered (stream
, ";");
668 fprintf_filtered (stream
, "\n%*send case;\n%*send record",
669 level
+4, "", level
, "");
675 /* Print function or procedure type TYPE on STREAM. Make it a header
676 for function or procedure NAME if NAME is not null. */
679 print_func_type (struct type
*type
, struct ui_file
*stream
, char* name
)
681 int i
, len
= TYPE_NFIELDS (type
);
683 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
)
684 fprintf_filtered (stream
, "procedure");
686 fprintf_filtered (stream
, "function");
688 if (name
!= NULL
&& name
[0] != '\0')
689 fprintf_filtered (stream
, " %s", name
);
693 fprintf_filtered (stream
, " (");
694 for (i
= 0; i
< len
; i
+= 1)
698 fputs_filtered ("; ", stream
);
701 fprintf_filtered (stream
, "a%d: ", i
+1);
702 ada_print_type (TYPE_FIELD_TYPE (type
, i
), "", stream
, -1, 0);
704 fprintf_filtered (stream
, ")");
707 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
709 fprintf_filtered (stream
, " return ");
710 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, 0, 0);
715 /* Print a description of a type TYPE0.
716 Output goes to STREAM (via stdio).
717 If VARSTRING is a non-empty string, print as an Ada variable/field
719 SHOW+1 is the maximum number of levels of internal type structure
720 to show (this applies to record types, enumerated types, and
722 SHOW is the number of levels of internal type structure to show
723 when there is a type name for the SHOWth deepest level (0th is
725 When SHOW<0, no inner structure is shown.
726 LEVEL indicates level of recursion (for nested definitions). */
729 ada_print_type (struct type
* type0
, char* varstring
, struct ui_file
* stream
,
734 struct type
* type
= ada_completed_type (ada_get_base_type (type0
));
735 char* type_name
= demangled_type_name (type
);
736 int is_var_decl
= (varstring
!= NULL
&& varstring
[0] != '\0');
741 fprintf_filtered (stream
, "%.*s: ",
742 ada_name_prefix_len(varstring
),
744 fprintf_filtered (stream
, "<null type?>");
749 CHECK_TYPEDEF (type
);
751 if (is_var_decl
&& TYPE_CODE (type
) != TYPE_CODE_FUNC
)
752 fprintf_filtered (stream
, "%.*s: ",
753 ada_name_prefix_len (varstring
), varstring
);
755 if (type_name
!= NULL
&& show
<= 0)
757 fprintf_filtered (stream
, "%.*s",
758 ada_name_prefix_len (type_name
), type_name
);
762 if (ada_is_aligner_type (type
))
763 ada_print_type (ada_aligned_type (type
), "", stream
, show
, level
);
764 else if (ada_is_packed_array_type (type
))
765 print_array_type (type
, stream
, show
, level
);
767 switch (TYPE_CODE (type
))
770 fprintf_filtered (stream
, "<");
771 c_print_type (type
, "", stream
, show
, level
);
772 fprintf_filtered (stream
, ">");
775 fprintf_filtered (stream
, "access ");
776 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
,
780 fprintf_filtered (stream
, "<ref> ");
781 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
,
784 case TYPE_CODE_ARRAY
:
785 print_array_type (type
, stream
, show
, level
);
788 if (ada_is_fixed_point_type (type
))
789 print_fixed_point_type (type
, stream
);
790 else if (ada_is_vax_floating_type (type
))
791 print_vax_floating_point_type (type
, stream
);
794 char* name
= ada_type_name (type
);
795 if (! ada_is_range_type_name (name
))
796 fprintf_filtered (stream
, "<%d-byte integer>", TYPE_LENGTH (type
));
799 fprintf_filtered (stream
, "range ");
800 print_range_type_named (name
, stream
);
804 case TYPE_CODE_RANGE
:
805 if (ada_is_fixed_point_type (type
))
806 print_fixed_point_type (type
, stream
);
807 else if (ada_is_vax_floating_type (type
))
808 print_vax_floating_point_type (type
, stream
);
809 else if (ada_is_modular_type (type
))
810 fprintf_filtered (stream
, "mod %ld", (long) ada_modulus (type
));
813 fprintf_filtered (stream
, "range ");
814 print_range (type
, stream
);
818 fprintf_filtered (stream
, "<%d-byte float>", TYPE_LENGTH (type
));
822 fprintf_filtered (stream
, "(...)");
824 print_enum_type (type
, stream
);
826 case TYPE_CODE_STRUCT
:
827 if (ada_is_array_descriptor (type
))
828 print_array_type (type
, stream
, show
, level
);
829 else if (ada_is_bogus_array_descriptor (type
))
830 fprintf_filtered (stream
, "array (?) of ? (<mal-formed descriptor>)");
832 print_record_type (type
, stream
, show
, level
);
834 case TYPE_CODE_UNION
:
835 print_unchecked_union_type (type
, stream
, show
, level
);
838 print_func_type (type
, stream
, varstring
);
This page took 0.046038 seconds and 5 git commands to generate.