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. */
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 (type
)
70 if (ada_type_name (type
) == NULL
)
74 char* raw_name
= ada_type_name (type
);
77 if (name_buffer
== NULL
|| name_buffer_len
<= strlen (raw_name
))
79 name_buffer_len
= 16 + 2 * strlen (raw_name
);
80 name_buffer
= xrealloc (name_buffer
, name_buffer_len
);
82 strcpy (name_buffer
, raw_name
);
84 s
= (char*) strstr (name_buffer
, "___");
88 s
= name_buffer
+ strlen (name_buffer
) - 1;
89 while (s
> name_buffer
&& (s
[0] != '_' || s
[-1] != '_'))
98 for (s
= q
= name_buffer
; *s
!= '\0'; q
+= 1)
100 if (s
[0] == '_' && s
[1] == '_')
115 /* Print a description of a type in the format of a
116 typedef for the current language.
117 NEW is the new name for a type TYPE. */
120 ada_typedef_print (type
, new, stream
)
123 struct ui_file
*stream
;
125 fprintf_filtered (stream
, "type %.*s is ",
126 ada_name_prefix_len (SYMBOL_SOURCE_NAME(new)),
127 SYMBOL_SOURCE_NAME(new));
128 type_print (type
, "", stream
, 1);
131 /* Print range type TYPE on STREAM. */
134 print_range (type
, stream
)
136 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 (type
, bounds
, n
, stream
)
190 struct ui_file
* stream
;
193 if (ada_scan_number (bounds
, *n
, &B
, n
))
195 ada_print_scalar (type
, B
, stream
);
196 if (bounds
[*n
] == '_')
202 char* bound
= bounds
+ *n
;
205 pend
= strstr (bound
, "__");
207 *n
+= bound_len
= strlen (bound
);
210 bound_len
= pend
- bound
;
213 fprintf_filtered (stream
, "%.*s", bound_len
, bound
);
217 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
218 the value (if found) of the bound indicated by SUFFIX ("___L" or
219 "___U") according to the ___XD conventions. */
222 print_dynamic_range_bound (type
, name
, name_len
, suffix
, stream
)
227 struct ui_file
* stream
;
229 static char *name_buf
= NULL
;
230 static size_t name_buf_len
= 0;
234 GROW_VECT (name_buf
, name_buf_len
, name_len
+ strlen (suffix
) + 1);
235 strncpy (name_buf
, name
, name_len
);
236 strcpy (name_buf
+ name_len
, suffix
);
238 B
= get_int_var_value (name_buf
, 0, &OK
);
240 ada_print_scalar (type
, B
, stream
);
242 fprintf_filtered (stream
, "?");
245 /* Print the range type named NAME. */
248 print_range_type_named (name
, stream
)
250 struct ui_file
* stream
;
252 struct type
*raw_type
= ada_find_any_type (name
);
253 struct type
*base_type
;
257 if (raw_type
== NULL
)
258 base_type
= builtin_type_int
;
259 else if (TYPE_CODE (raw_type
) == TYPE_CODE_RANGE
)
260 base_type
= TYPE_TARGET_TYPE (raw_type
);
262 base_type
= raw_type
;
264 subtype_info
= strstr (name
, "___XD");
265 if (subtype_info
== NULL
&& raw_type
== NULL
)
266 fprintf_filtered (stream
, "? .. ?");
267 else if (subtype_info
== NULL
)
268 print_range (raw_type
, stream
);
271 int prefix_len
= subtype_info
- name
;
276 bounds_str
= strchr (subtype_info
, '_');
279 if (*subtype_info
== 'L')
281 print_range_bound (raw_type
, bounds_str
, &n
, stream
);
285 print_dynamic_range_bound (raw_type
, name
, prefix_len
, "___L", stream
);
287 fprintf_filtered (stream
, " .. ");
289 if (*subtype_info
== 'U')
290 print_range_bound (raw_type
, bounds_str
, &n
, stream
);
292 print_dynamic_range_bound (raw_type
, name
, prefix_len
, "___U", stream
);
296 /* Print enumerated type TYPE on STREAM. */
299 print_enum_type (type
, stream
)
301 struct ui_file
*stream
;
303 int len
= TYPE_NFIELDS (type
);
306 fprintf_filtered (stream
, "(");
310 for (i
= 0; i
< len
; i
++)
313 if (i
) fprintf_filtered (stream
, ", ");
315 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type
, i
)), stream
);
316 if (lastval
!= TYPE_FIELD_BITPOS (type
, i
))
318 fprintf_filtered (stream
, " => %d", TYPE_FIELD_BITPOS (type
, i
));
319 lastval
= TYPE_FIELD_BITPOS (type
, i
);
323 fprintf_filtered (stream
, ")");
326 /* Print representation of Ada fixed-point type TYPE on STREAM. */
329 print_fixed_point_type (type
, stream
)
331 struct ui_file
*stream
;
333 DOUBLEST delta
= ada_delta (type
);
334 DOUBLEST small
= ada_fixed_to_float (type
, 1.0);
337 fprintf_filtered (stream
, "delta ??");
340 fprintf_filtered (stream
, "delta %g", (double) delta
);
342 fprintf_filtered (stream
, " <'small = %g>", (double) small
);
346 /* Print representation of special VAX floating-point type TYPE on STREAM. */
349 print_vax_floating_point_type (type
, stream
)
351 struct ui_file
*stream
;
353 fprintf_filtered (stream
, "<float format %c>",
354 ada_vax_float_type_suffix (type
));
357 /* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
358 recursion (indentation) level, in case the element type itself has
359 nested structure, and SHOW is the number of levels of internal
360 structure to show (see ada_print_type). */
363 print_array_type (type
, stream
, show
, level
)
365 struct ui_file
*stream
;
373 fprintf_filtered (stream
, "array (");
377 fprintf_filtered (stream
, "...");
380 if (ada_is_packed_array_type (type
))
381 type
= ada_coerce_to_simple_array_type (type
);
382 if (ada_is_simple_array (type
))
384 struct type
* range_desc_type
=
385 ada_find_parallel_type (type
, "___XA");
386 struct type
* arr_type
;
389 if (range_desc_type
== NULL
)
391 for (arr_type
= type
; TYPE_CODE (arr_type
) == TYPE_CODE_ARRAY
;
392 arr_type
= TYPE_TARGET_TYPE (arr_type
))
394 if (arr_type
!= type
)
395 fprintf_filtered (stream
, ", ");
396 print_range (TYPE_INDEX_TYPE (arr_type
), stream
);
397 if (TYPE_FIELD_BITSIZE (arr_type
, 0) > 0)
398 bitsize
= TYPE_FIELD_BITSIZE (arr_type
, 0);
404 n_indices
= TYPE_NFIELDS (range_desc_type
);
405 for (k
= 0, arr_type
= type
;
407 k
+= 1, arr_type
= TYPE_TARGET_TYPE (arr_type
))
410 fprintf_filtered (stream
, ", ");
411 print_range_type_named (TYPE_FIELD_NAME (range_desc_type
, k
),
413 if (TYPE_FIELD_BITSIZE (arr_type
, 0) > 0)
414 bitsize
= TYPE_FIELD_BITSIZE (arr_type
, 0);
421 for (i
= i0
= ada_array_arity (type
); i
> 0; i
-= 1)
422 fprintf_filtered (stream
, "%s<>", i
== i0
? "" : ", ");
426 fprintf_filtered (stream
, ") of ");
428 ada_print_type (ada_array_element_type (type
, n_indices
), "", stream
,
429 show
== 0 ? 0 : show
-1, level
+1);
431 fprintf_filtered (stream
, " <packed: %d-bit elements>", bitsize
);
434 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
435 STREAM, assuming the VAL_TYPE is the type of the values. */
438 print_choices (type
, field_num
, stream
, val_type
)
441 struct ui_file
*stream
;
442 struct type
*val_type
;
446 const char* name
= TYPE_FIELD_NAME (type
, field_num
);
450 /* Skip over leading 'V': NOTE soon to be obsolete. */
453 if (! ada_scan_number (name
, 1, NULL
, &p
))
469 fprintf_filtered (stream
, " | ");
479 if (! ada_scan_number (name
, p
+ 1, &W
, &p
))
481 ada_print_scalar (val_type
, W
, stream
);
487 if (! ada_scan_number (name
, p
+ 1, &L
, &p
)
489 || ! ada_scan_number (name
, p
+ 1, &U
, &p
))
491 ada_print_scalar (val_type
, L
, stream
);
492 fprintf_filtered (stream
, " .. ");
493 ada_print_scalar (val_type
, U
, stream
);
497 fprintf_filtered (stream
, "others");
504 fprintf_filtered (stream
, "??");
508 /* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
509 discriminant is contained in OUTER_TYPE, print its variants on STREAM.
510 LEVEL is the recursion
511 (indentation) level, in case any of the fields themselves have
512 nested structure, and SHOW is the number of levels of internal structure
513 to show (see ada_print_type). For this purpose, fields nested in a
514 variant part are taken to be at the same level as the fields
515 immediately outside the variant part. */
518 print_variant_clauses (type
, field_num
, outer_type
, stream
, show
, level
)
521 struct type
*outer_type
;
522 struct ui_file
*stream
;
527 struct type
*var_type
;
528 struct type
*discr_type
;
530 var_type
= TYPE_FIELD_TYPE (type
, field_num
);
531 discr_type
= ada_variant_discrim_type (var_type
, outer_type
);
533 if (TYPE_CODE (var_type
) == TYPE_CODE_PTR
)
535 var_type
= TYPE_TARGET_TYPE (var_type
);
536 if (TYPE_FLAGS (var_type
) & TYPE_FLAG_STUB
)
538 var_type
= ada_find_parallel_type (var_type
, "___XVU");
539 if (var_type
== NULL
)
544 for (i
= 0; i
< TYPE_NFIELDS (var_type
); i
+= 1)
546 fprintf_filtered (stream
, "\n%*swhen ", level
+ 4, "");
547 print_choices (var_type
, i
, stream
, discr_type
);
548 fprintf_filtered (stream
, " =>");
549 if (print_record_field_types (TYPE_FIELD_TYPE (var_type
, i
),
550 outer_type
, stream
, show
, level
+4) <= 0)
551 fprintf_filtered (stream
, " null;");
555 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
556 discriminants are contained in OUTER_TYPE, print a description of it
557 on STREAM. LEVEL is the recursion (indentation) level, in case any of
558 the fields themselves have nested structure, and SHOW is the number of
559 levels of internal structure to show (see ada_print_type). For this
560 purpose, fields nested in a variant part are taken to be at the same
561 level as the fields immediately outside the variant part. */
564 print_variant_part (type
, field_num
, outer_type
, stream
, show
, level
)
567 struct type
*outer_type
;
568 struct ui_file
*stream
;
572 fprintf_filtered (stream
, "\n%*scase %s is", level
+ 4, "",
573 ada_variant_discrim_name
574 (TYPE_FIELD_TYPE (type
, field_num
)));
575 print_variant_clauses (type
, field_num
, outer_type
, stream
, show
, level
+ 4);
576 fprintf_filtered (stream
, "\n%*send case;", level
+ 4, "");
579 /* Print a description on STREAM of the fields in record type TYPE, whose
580 discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
581 level, in case any of the fields themselves have nested structure,
582 and SHOW is the number of levels of internal structure to show
583 (see ada_print_type). Does not print parent type information of TYPE.
584 Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
585 Prints each field beginning on a new line, but does not put a new line at
589 print_record_field_types (type
, outer_type
, stream
, show
, level
)
591 struct type
*outer_type
;
592 struct ui_file
*stream
;
599 len
= TYPE_NFIELDS (type
);
601 if (len
== 0 && (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
) != 0)
604 for (i
= 0; i
< len
; i
+= 1)
608 if (ada_is_parent_field (type
, i
)
609 || ada_is_ignored_field (type
, i
))
611 else if (ada_is_wrapper_field (type
, i
))
612 flds
+= print_record_field_types (TYPE_FIELD_TYPE (type
, i
), type
,
613 stream
, show
, level
);
614 else if (ada_is_variant_part (type
, i
))
616 print_variant_part (type
, i
, outer_type
, stream
, show
, level
);
622 fprintf_filtered (stream
, "\n%*s", level
+ 4, "");
623 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
624 TYPE_FIELD_NAME (type
, i
),
625 stream
, show
- 1, level
+ 4);
626 fprintf_filtered (stream
, ";");
633 /* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
634 level, in case the element type itself has nested structure, and SHOW is
635 the number of levels of internal structure to show (see ada_print_type). */
638 print_record_type (type0
, stream
, show
, level
)
640 struct ui_file
* stream
;
644 struct type
* parent_type
;
648 if (TYPE_FLAGS (type
) & TYPE_FLAG_STUB
)
650 struct type
* type1
= ada_find_parallel_type (type
, "___XVE");
655 parent_type
= ada_parent_type (type
);
656 if (ada_type_name (parent_type
) != NULL
)
657 fprintf_filtered (stream
, "new %s with ",
658 demangled_type_name (parent_type
));
659 else if (parent_type
== NULL
&& ada_is_tagged_type (type
))
660 fprintf_filtered (stream
, "tagged ");
662 fprintf_filtered (stream
, "record");
665 fprintf_filtered (stream
, " ... end record");
671 if (parent_type
!= NULL
&& ada_type_name (parent_type
) == NULL
)
672 flds
+= print_record_field_types (parent_type
, parent_type
,
673 stream
, show
, level
);
674 flds
+= print_record_field_types (type
, type
, stream
, show
, level
);
677 fprintf_filtered (stream
, "\n%*send record", level
, "");
679 fprintf_filtered (stream
, " <incomplete type> end record");
681 fprintf_filtered (stream
, " null; end record");
685 /* Print the unchecked union type TYPE in something resembling Ada
686 format on STREAM. LEVEL is the recursion (indentation) level
687 in case the element type itself has nested structure, and SHOW is the
688 number of levels of internal structure to show (see ada_print_type). */
690 print_unchecked_union_type (struct type
* type
, struct ui_file
* stream
,
693 fprintf_filtered (stream
, "record (?) is");
696 fprintf_filtered (stream
, " ... end record");
697 else if (TYPE_NFIELDS (type
) == 0)
698 fprintf_filtered (stream
, " null; end record");
703 fprintf_filtered (stream
, "\n%*scase ? is",
706 for (i
= 0; i
< TYPE_NFIELDS (type
); i
+= 1)
708 fprintf_filtered (stream
, "\n%*swhen ? =>\n%*s", level
+8, "",
710 ada_print_type (TYPE_FIELD_TYPE (type
, i
),
711 TYPE_FIELD_NAME (type
, i
),
712 stream
, show
- 1, level
+ 12);
713 fprintf_filtered (stream
, ";");
716 fprintf_filtered (stream
, "\n%*send case;\n%*send record",
717 level
+4, "", level
, "");
723 /* Print function or procedure type TYPE on STREAM. Make it a header
724 for function or procedure NAME if NAME is not null. */
727 print_func_type (type
, stream
, name
)
729 struct ui_file
*stream
;
732 int i
, len
= TYPE_NFIELDS (type
);
734 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_VOID
)
735 fprintf_filtered (stream
, "procedure");
737 fprintf_filtered (stream
, "function");
739 if (name
!= NULL
&& name
[0] != '\0')
740 fprintf_filtered (stream
, " %s", name
);
744 fprintf_filtered (stream
, " (");
745 for (i
= 0; i
< len
; i
+= 1)
749 fputs_filtered ("; ", stream
);
752 fprintf_filtered (stream
, "a%d: ", i
+1);
753 ada_print_type (TYPE_FIELD_TYPE (type
, i
), "", stream
, -1, 0);
755 fprintf_filtered (stream
, ")");
758 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_VOID
)
760 fprintf_filtered (stream
, " return ");
761 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, 0, 0);
766 /* Print a description of a type TYPE0.
767 Output goes to STREAM (via stdio).
768 If VARSTRING is a non-empty string, print as an Ada variable/field
770 SHOW+1 is the maximum number of levels of internal type structure
771 to show (this applies to record types, enumerated types, and
773 SHOW is the number of levels of internal type structure to show
774 when there is a type name for the SHOWth deepest level (0th is
776 When SHOW<0, no inner structure is shown.
777 LEVEL indicates level of recursion (for nested definitions). */
780 ada_print_type (type0
, varstring
, stream
, show
, level
)
783 struct ui_file
* stream
;
789 struct type
* type
= ada_completed_type (ada_get_base_type (type0
));
790 char* type_name
= demangled_type_name (type
);
791 int is_var_decl
= (varstring
!= NULL
&& varstring
[0] != '\0');
796 fprintf_filtered (stream
, "%.*s: ",
797 ada_name_prefix_len(varstring
),
799 fprintf_filtered (stream
, "<null type?>");
804 CHECK_TYPEDEF (type
);
806 if (is_var_decl
&& TYPE_CODE (type
) != TYPE_CODE_FUNC
)
807 fprintf_filtered (stream
, "%.*s: ",
808 ada_name_prefix_len (varstring
), varstring
);
810 if (type_name
!= NULL
&& show
<= 0)
812 fprintf_filtered (stream
, "%.*s",
813 ada_name_prefix_len (type_name
), type_name
);
817 if (ada_is_aligner_type (type
))
818 ada_print_type (ada_aligned_type (type
), "", stream
, show
, level
);
819 else if (ada_is_packed_array_type (type
))
820 print_array_type (type
, stream
, show
, level
);
822 switch (TYPE_CODE (type
))
825 fprintf_filtered (stream
, "<");
826 c_print_type (type
, "", stream
, show
, level
);
827 fprintf_filtered (stream
, ">");
830 fprintf_filtered (stream
, "access ");
831 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
,
835 fprintf_filtered (stream
, "<ref> ");
836 ada_print_type (TYPE_TARGET_TYPE (type
), "", stream
, show
,
839 case TYPE_CODE_ARRAY
:
840 print_array_type (type
, stream
, show
, level
);
843 if (ada_is_fixed_point_type (type
))
844 print_fixed_point_type (type
, stream
);
845 else if (ada_is_vax_floating_type (type
))
846 print_vax_floating_point_type (type
, stream
);
849 char* name
= ada_type_name (type
);
850 if (! ada_is_range_type_name (name
))
851 fprintf_filtered (stream
, "<%d-byte integer>", TYPE_LENGTH (type
));
854 fprintf_filtered (stream
, "range ");
855 print_range_type_named (name
, stream
);
859 case TYPE_CODE_RANGE
:
860 if (ada_is_fixed_point_type (type
))
861 print_fixed_point_type (type
, stream
);
862 else if (ada_is_vax_floating_type (type
))
863 print_vax_floating_point_type (type
, stream
);
864 else if (ada_is_modular_type (type
))
865 fprintf_filtered (stream
, "mod %ld", (long) ada_modulus (type
));
868 fprintf_filtered (stream
, "range ");
869 print_range (type
, stream
);
873 fprintf_filtered (stream
, "<%d-byte float>", TYPE_LENGTH (type
));
877 fprintf_filtered (stream
, "(...)");
879 print_enum_type (type
, stream
);
881 case TYPE_CODE_STRUCT
:
882 if (ada_is_array_descriptor (type
))
883 print_array_type (type
, stream
, show
, level
);
884 else if (ada_is_bogus_array_descriptor (type
))
885 fprintf_filtered (stream
, "array (?) of ? (<mal-formed descriptor>)");
887 print_record_type (type
, stream
, show
, level
);
889 case TYPE_CODE_UNION
:
890 print_unchecked_union_type (type
, stream
, show
, level
);
893 print_func_type (type
, stream
, varstring
);
This page took 0.048549 seconds and 4 git commands to generate.