1 /* Support for printing Ada values for GDB, the GNU debugger.
3 Copyright (C) 1986-2020 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/>. */
23 #include "expression.h"
29 #include "target-float.h"
30 #include "cli/cli-style.h"
33 static int print_field_values (struct value
*, struct value
*,
34 struct ui_file
*, int,
35 const struct value_print_options
*,
36 int, const struct language_defn
*);
40 /* Make TYPE unsigned if its range of values includes no negatives. */
42 adjust_type_signedness (struct type
*type
)
44 if (type
!= NULL
&& type
->code () == TYPE_CODE_RANGE
45 && type
->bounds ()->low
.const_val () >= 0)
46 type
->set_is_unsigned (true);
49 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
50 if non-standard (i.e., other than 1 for numbers, other than lower bound
51 of index type for enumerated type). Returns 1 if something printed,
55 print_optional_low_bound (struct ui_file
*stream
, struct type
*type
,
56 const struct value_print_options
*options
)
58 struct type
*index_type
;
62 if (options
->print_array_indexes
)
65 if (!get_array_bounds (type
, &low_bound
, &high_bound
))
68 /* If this is an empty array, then don't print the lower bound.
69 That would be confusing, because we would print the lower bound,
70 followed by... nothing! */
71 if (low_bound
> high_bound
)
74 index_type
= type
->index_type ();
76 while (index_type
->code () == TYPE_CODE_RANGE
)
78 /* We need to know what the base type is, in order to do the
79 appropriate check below. Otherwise, if this is a subrange
80 of an enumerated type, where the underlying value of the
81 first element is typically 0, we might test the low bound
82 against the wrong value. */
83 index_type
= TYPE_TARGET_TYPE (index_type
);
86 /* Don't print the lower bound if it's the default one. */
87 switch (index_type
->code ())
97 low_bound
= TYPE_FIELD_ENUMVAL (index_type
, low_bound
);
108 ada_print_scalar (index_type
, low_bound
, stream
);
109 fprintf_filtered (stream
, " => ");
113 /* Version of val_print_array_elements for GNAT-style packed arrays.
114 Prints elements of packed array of type TYPE from VALADDR on
115 STREAM. Formats according to OPTIONS and separates with commas.
116 RECURSE is the recursion (nesting) level. TYPE must have been
117 decoded (as by ada_coerce_to_simple_array). */
120 val_print_packed_array_elements (struct type
*type
, const gdb_byte
*valaddr
,
121 int offset
, struct ui_file
*stream
,
123 const struct value_print_options
*options
)
126 unsigned int things_printed
= 0;
128 struct type
*elttype
, *index_type
;
129 unsigned long bitsize
= TYPE_FIELD_BITSIZE (type
, 0);
130 struct value
*mark
= value_mark ();
133 elttype
= TYPE_TARGET_TYPE (type
);
134 index_type
= type
->index_type ();
139 if (get_discrete_bounds (index_type
, &low
, &high
) < 0)
143 /* The array length should normally be HIGH_POS - LOW_POS + 1.
144 But in Ada we allow LOW_POS to be greater than HIGH_POS for
145 empty arrays. In that situation, the array length is just zero,
150 len
= high
- low
+ 1;
153 if (index_type
->code () == TYPE_CODE_RANGE
)
154 index_type
= TYPE_TARGET_TYPE (index_type
);
157 annotate_array_section_begin (i
, elttype
);
159 while (i
< len
&& things_printed
< options
->print_max
)
161 struct value
*v0
, *v1
;
166 if (options
->prettyformat_arrays
)
168 fprintf_filtered (stream
, ",\n");
169 print_spaces_filtered (2 + 2 * recurse
, stream
);
173 fprintf_filtered (stream
, ", ");
176 else if (options
->prettyformat_arrays
)
178 fprintf_filtered (stream
, "\n");
179 print_spaces_filtered (2 + 2 * recurse
, stream
);
181 wrap_here (n_spaces (2 + 2 * recurse
));
182 maybe_print_array_index (index_type
, i
+ low
, stream
, options
);
185 v0
= ada_value_primitive_packed_val (NULL
, valaddr
+ offset
,
186 (i0
* bitsize
) / HOST_CHAR_BIT
,
187 (i0
* bitsize
) % HOST_CHAR_BIT
,
194 v1
= ada_value_primitive_packed_val (NULL
, valaddr
+ offset
,
195 (i
* bitsize
) / HOST_CHAR_BIT
,
196 (i
* bitsize
) % HOST_CHAR_BIT
,
198 if (TYPE_LENGTH (check_typedef (value_type (v0
)))
199 != TYPE_LENGTH (check_typedef (value_type (v1
))))
201 if (!value_contents_eq (v0
, value_embedded_offset (v0
),
202 v1
, value_embedded_offset (v1
),
203 TYPE_LENGTH (check_typedef (value_type (v0
)))))
207 if (i
- i0
> options
->repeat_count_threshold
)
209 struct value_print_options opts
= *options
;
212 common_val_print (v0
, stream
, recurse
+ 1, &opts
, current_language
);
213 annotate_elt_rep (i
- i0
);
214 fprintf_filtered (stream
, _(" %p[<repeats %u times>%p]"),
215 metadata_style
.style ().ptr (), i
- i0
, nullptr);
216 annotate_elt_rep_end ();
222 struct value_print_options opts
= *options
;
225 for (j
= i0
; j
< i
; j
+= 1)
229 if (options
->prettyformat_arrays
)
231 fprintf_filtered (stream
, ",\n");
232 print_spaces_filtered (2 + 2 * recurse
, stream
);
236 fprintf_filtered (stream
, ", ");
238 wrap_here (n_spaces (2 + 2 * recurse
));
239 maybe_print_array_index (index_type
, j
+ low
,
242 common_val_print (v0
, stream
, recurse
+ 1, &opts
,
247 things_printed
+= i
- i0
;
249 annotate_array_section_end ();
252 fprintf_filtered (stream
, "...");
255 value_free_to_mark (mark
);
258 /* Print the character C on STREAM as part of the contents of a literal
259 string whose delimiter is QUOTER. TYPE_LEN is the length in bytes
263 ada_emit_char (int c
, struct type
*type
, struct ui_file
*stream
,
264 int quoter
, int type_len
)
266 /* If this character fits in the normal ASCII range, and is
267 a printable character, then print the character as if it was
268 an ASCII character, even if this is a wide character.
269 The UCHAR_MAX check is necessary because the isascii function
270 requires that its argument have a value of an unsigned char,
271 or EOF (EOF is obviously not printable). */
272 if (c
<= UCHAR_MAX
&& isascii (c
) && isprint (c
))
274 if (c
== quoter
&& c
== '"')
275 fprintf_filtered (stream
, "\"\"");
277 fprintf_filtered (stream
, "%c", c
);
280 fprintf_filtered (stream
, "[\"%0*x\"]", type_len
* 2, c
);
283 /* Character #I of STRING, given that TYPE_LEN is the size in bytes
287 char_at (const gdb_byte
*string
, int i
, int type_len
,
288 enum bfd_endian byte_order
)
293 return (int) extract_unsigned_integer (string
+ type_len
* i
,
294 type_len
, byte_order
);
297 /* Print a floating-point value of type TYPE, pointed to in GDB by
298 VALADDR, on STREAM. Use Ada formatting conventions: there must be
299 a decimal point, and at least one digit before and after the
300 point. We use the GNAT format for NaNs and infinities. */
303 ada_print_floating (const gdb_byte
*valaddr
, struct type
*type
,
304 struct ui_file
*stream
)
306 string_file tmp_stream
;
308 print_floating (valaddr
, type
, &tmp_stream
);
310 std::string
&s
= tmp_stream
.string ();
311 size_t skip_count
= 0;
313 /* Modify for Ada rules. */
315 size_t pos
= s
.find ("inf");
316 if (pos
== std::string::npos
)
317 pos
= s
.find ("Inf");
318 if (pos
== std::string::npos
)
319 pos
= s
.find ("INF");
320 if (pos
!= std::string::npos
)
321 s
.replace (pos
, 3, "Inf");
323 if (pos
== std::string::npos
)
325 pos
= s
.find ("nan");
326 if (pos
== std::string::npos
)
327 pos
= s
.find ("NaN");
328 if (pos
== std::string::npos
)
329 pos
= s
.find ("Nan");
330 if (pos
!= std::string::npos
)
332 s
[pos
] = s
[pos
+ 2] = 'N';
338 if (pos
== std::string::npos
339 && s
.find ('.') == std::string::npos
)
342 if (pos
== std::string::npos
)
343 fprintf_filtered (stream
, "%s.0", s
.c_str ());
345 fprintf_filtered (stream
, "%.*s.0%s", (int) pos
, s
.c_str (), &s
[pos
]);
348 fprintf_filtered (stream
, "%s", &s
[skip_count
]);
352 ada_printchar (int c
, struct type
*type
, struct ui_file
*stream
)
354 fputs_filtered ("'", stream
);
355 ada_emit_char (c
, type
, stream
, '\'', TYPE_LENGTH (type
));
356 fputs_filtered ("'", stream
);
359 /* [From print_type_scalar in typeprint.c]. Print VAL on STREAM in a
360 form appropriate for TYPE, if non-NULL. If TYPE is NULL, print VAL
361 like a default signed integer. */
364 ada_print_scalar (struct type
*type
, LONGEST val
, struct ui_file
*stream
)
371 print_longest (stream
, 'd', 0, val
);
375 type
= ada_check_typedef (type
);
377 switch (type
->code ())
381 len
= type
->num_fields ();
382 for (i
= 0; i
< len
; i
++)
384 if (TYPE_FIELD_ENUMVAL (type
, i
) == val
)
391 fputs_styled (ada_enum_name (TYPE_FIELD_NAME (type
, i
)),
392 variable_name_style
.style (), stream
);
396 print_longest (stream
, 'd', 0, val
);
401 print_longest (stream
, type
->is_unsigned () ? 'u' : 'd', 0, val
);
405 LA_PRINT_CHAR (val
, type
, stream
);
409 fprintf_filtered (stream
, val
? "true" : "false");
412 case TYPE_CODE_RANGE
:
413 ada_print_scalar (TYPE_TARGET_TYPE (type
), val
, stream
);
416 case TYPE_CODE_UNDEF
:
418 case TYPE_CODE_ARRAY
:
419 case TYPE_CODE_STRUCT
:
420 case TYPE_CODE_UNION
:
425 case TYPE_CODE_STRING
:
426 case TYPE_CODE_ERROR
:
427 case TYPE_CODE_MEMBERPTR
:
428 case TYPE_CODE_METHODPTR
:
429 case TYPE_CODE_METHOD
:
431 warning (_("internal error: unhandled type in ada_print_scalar"));
435 error (_("Invalid type code in symbol table."));
439 /* Print the character string STRING, printing at most LENGTH characters.
440 Printing stops early if the number hits print_max; repeat counts
441 are printed as appropriate. Print ellipses at the end if we
442 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
443 TYPE_LEN is the length (1 or 2) of the character type. */
446 printstr (struct ui_file
*stream
, struct type
*elttype
, const gdb_byte
*string
,
447 unsigned int length
, int force_ellipses
, int type_len
,
448 const struct value_print_options
*options
)
450 enum bfd_endian byte_order
= type_byte_order (elttype
);
452 unsigned int things_printed
= 0;
458 fputs_filtered ("\"\"", stream
);
462 for (i
= 0; i
< length
&& things_printed
< options
->print_max
; i
+= 1)
464 /* Position of the character we are examining
465 to see whether it is repeated. */
467 /* Number of repetitions we have detected so far. */
474 fputs_filtered (", ", stream
);
481 && char_at (string
, rep1
, type_len
, byte_order
)
482 == char_at (string
, i
, type_len
, byte_order
))
488 if (reps
> options
->repeat_count_threshold
)
492 fputs_filtered ("\", ", stream
);
495 fputs_filtered ("'", stream
);
496 ada_emit_char (char_at (string
, i
, type_len
, byte_order
),
497 elttype
, stream
, '\'', type_len
);
498 fputs_filtered ("'", stream
);
499 fprintf_filtered (stream
, _(" %p[<repeats %u times>%p]"),
500 metadata_style
.style ().ptr (), reps
, nullptr);
502 things_printed
+= options
->repeat_count_threshold
;
509 fputs_filtered ("\"", stream
);
512 ada_emit_char (char_at (string
, i
, type_len
, byte_order
),
513 elttype
, stream
, '"', type_len
);
518 /* Terminate the quotes if necessary. */
520 fputs_filtered ("\"", stream
);
522 if (force_ellipses
|| i
< length
)
523 fputs_filtered ("...", stream
);
527 ada_printstr (struct ui_file
*stream
, struct type
*type
,
528 const gdb_byte
*string
, unsigned int length
,
529 const char *encoding
, int force_ellipses
,
530 const struct value_print_options
*options
)
532 printstr (stream
, type
, string
, length
, force_ellipses
, TYPE_LENGTH (type
),
537 print_variant_part (struct value
*value
, int field_num
,
538 struct value
*outer_value
,
539 struct ui_file
*stream
, int recurse
,
540 const struct value_print_options
*options
,
542 const struct language_defn
*language
)
544 struct type
*type
= value_type (value
);
545 struct type
*var_type
= type
->field (field_num
).type ();
546 int which
= ada_which_variant_applies (var_type
, outer_value
);
551 struct value
*variant_field
= value_field (value
, field_num
);
552 struct value
*active_component
= value_field (variant_field
, which
);
553 return print_field_values (active_component
, outer_value
, stream
, recurse
,
554 options
, comma_needed
, language
);
557 /* Print out fields of VALUE.
559 STREAM, RECURSE, and OPTIONS have the same meanings as in
560 ada_print_value and ada_value_print.
562 OUTER_VALUE gives the enclosing record (used to get discriminant
563 values when printing variant parts).
565 COMMA_NEEDED is 1 if fields have been printed at the current recursion
566 level, so that a comma is needed before any field printed by this
569 Returns 1 if COMMA_NEEDED or any fields were printed. */
572 print_field_values (struct value
*value
, struct value
*outer_value
,
573 struct ui_file
*stream
, int recurse
,
574 const struct value_print_options
*options
,
576 const struct language_defn
*language
)
580 struct type
*type
= value_type (value
);
581 len
= type
->num_fields ();
583 for (i
= 0; i
< len
; i
+= 1)
585 if (ada_is_ignored_field (type
, i
))
588 if (ada_is_wrapper_field (type
, i
))
590 struct value
*field_val
= ada_value_primitive_field (value
, 0,
593 print_field_values (field_val
, field_val
,
594 stream
, recurse
, options
,
595 comma_needed
, language
);
598 else if (ada_is_variant_part (type
, i
))
601 print_variant_part (value
, i
, outer_value
, stream
, recurse
,
602 options
, comma_needed
, language
);
607 fprintf_filtered (stream
, ", ");
610 if (options
->prettyformat
)
612 fprintf_filtered (stream
, "\n");
613 print_spaces_filtered (2 + 2 * recurse
, stream
);
617 wrap_here (n_spaces (2 + 2 * recurse
));
620 annotate_field_begin (type
->field (i
).type ());
621 fprintf_filtered (stream
, "%.*s",
622 ada_name_prefix_len (TYPE_FIELD_NAME (type
, i
)),
623 TYPE_FIELD_NAME (type
, i
));
624 annotate_field_name_end ();
625 fputs_filtered (" => ", stream
);
626 annotate_field_value ();
628 if (TYPE_FIELD_PACKED (type
, i
))
630 /* Bitfields require special handling, especially due to byte
632 if (HAVE_CPLUS_STRUCT (type
) && TYPE_FIELD_IGNORE (type
, i
))
634 fputs_styled (_("<optimized out or zero length>"),
635 metadata_style
.style (), stream
);
640 int bit_pos
= TYPE_FIELD_BITPOS (type
, i
);
641 int bit_size
= TYPE_FIELD_BITSIZE (type
, i
);
642 struct value_print_options opts
;
644 adjust_type_signedness (type
->field (i
).type ());
645 v
= ada_value_primitive_packed_val
647 bit_pos
/ HOST_CHAR_BIT
,
648 bit_pos
% HOST_CHAR_BIT
,
649 bit_size
, type
->field (i
).type ());
652 common_val_print (v
, stream
, recurse
+ 1, &opts
, language
);
657 struct value_print_options opts
= *options
;
661 struct value
*v
= value_field (value
, i
);
662 common_val_print (v
, stream
, recurse
+ 1, &opts
, language
);
664 annotate_field_end ();
670 /* Implement Ada val_print'ing for the case where TYPE is
671 a TYPE_CODE_ARRAY of characters. */
674 ada_val_print_string (struct type
*type
, const gdb_byte
*valaddr
,
676 struct ui_file
*stream
, int recurse
,
677 const struct value_print_options
*options
)
679 enum bfd_endian byte_order
= type_byte_order (type
);
680 struct type
*elttype
= TYPE_TARGET_TYPE (type
);
684 /* We know that ELTTYPE cannot possibly be null, because we assume
685 that we're called only when TYPE is a string-like type.
686 Similarly, the size of ELTTYPE should also be non-null, since
687 it's a character-like type. */
688 gdb_assert (elttype
!= NULL
);
689 gdb_assert (TYPE_LENGTH (elttype
) != 0);
691 eltlen
= TYPE_LENGTH (elttype
);
692 len
= TYPE_LENGTH (type
) / eltlen
;
694 /* If requested, look for the first null char and only print
695 elements up to it. */
696 if (options
->stop_print_at_null
)
700 /* Look for a NULL char. */
703 && temp_len
< options
->print_max
704 && char_at (valaddr
+ offset_aligned
,
705 temp_len
, eltlen
, byte_order
) != 0);
710 printstr (stream
, elttype
, valaddr
+ offset_aligned
, len
, 0,
714 /* Implement Ada value_print'ing for the case where TYPE is a
718 ada_value_print_ptr (struct value
*val
,
719 struct ui_file
*stream
, int recurse
,
720 const struct value_print_options
*options
)
722 common_val_print (val
, stream
, recurse
, options
, language_def (language_c
));
724 struct type
*type
= ada_check_typedef (value_type (val
));
725 if (ada_is_tag_type (type
))
727 gdb::unique_xmalloc_ptr
<char> name
= ada_tag_name (val
);
730 fprintf_filtered (stream
, " (%s)", name
.get ());
734 /* Implement Ada val_print'ing for the case where TYPE is
735 a TYPE_CODE_INT or TYPE_CODE_RANGE. */
738 ada_value_print_num (struct value
*val
, struct ui_file
*stream
, int recurse
,
739 const struct value_print_options
*options
)
741 struct type
*type
= ada_check_typedef (value_type (val
));
742 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
744 if (ada_is_gnat_encoded_fixed_point_type (type
))
746 struct value
*scale
= gnat_encoded_fixed_point_scaling_factor (type
);
747 val
= value_cast (value_type (scale
), val
);
748 val
= value_binop (val
, scale
, BINOP_MUL
);
750 const char *fmt
= TYPE_LENGTH (type
) < 4 ? "%.11g" : "%.17g";
752 = target_float_to_string (value_contents (val
), value_type (val
), fmt
);
753 fputs_filtered (str
.c_str (), stream
);
756 else if (type
->code () == TYPE_CODE_RANGE
757 && (TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_ENUM
758 || TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_BOOL
759 || TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_CHAR
))
761 /* For enum-valued ranges, we want to recurse, because we'll end
762 up printing the constant's name rather than its numeric
763 value. Character and fixed-point types are also printed
764 differently, so recuse for those as well. */
765 struct type
*target_type
= TYPE_TARGET_TYPE (type
);
766 val
= value_cast (target_type
, val
);
767 common_val_print (val
, stream
, recurse
+ 1, options
,
768 language_def (language_ada
));
773 int format
= (options
->format
? options
->format
774 : options
->output_format
);
778 struct value_print_options opts
= *options
;
780 opts
.format
= format
;
781 value_print_scalar_formatted (val
, &opts
, 0, stream
);
783 else if (ada_is_system_address_type (type
))
785 /* FIXME: We want to print System.Address variables using
786 the same format as for any access type. But for some
787 reason GNAT encodes the System.Address type as an int,
788 so we have to work-around this deficiency by handling
789 System.Address values as a special case. */
791 struct gdbarch
*gdbarch
= get_type_arch (type
);
792 struct type
*ptr_type
= builtin_type (gdbarch
)->builtin_data_ptr
;
793 CORE_ADDR addr
= extract_typed_address (valaddr
, ptr_type
);
795 fprintf_filtered (stream
, "(");
796 type_print (type
, "", stream
, -1);
797 fprintf_filtered (stream
, ") ");
798 fputs_filtered (paddress (gdbarch
, addr
), stream
);
802 value_print_scalar_formatted (val
, options
, 0, stream
);
803 if (ada_is_character_type (type
))
807 fputs_filtered (" ", stream
);
808 c
= unpack_long (type
, valaddr
);
809 ada_printchar (c
, type
, stream
);
816 /* Implement Ada val_print'ing for the case where TYPE is
820 ada_val_print_enum (struct value
*value
, struct ui_file
*stream
, int recurse
,
821 const struct value_print_options
*options
)
829 value_print_scalar_formatted (value
, options
, 0, stream
);
833 struct type
*type
= ada_check_typedef (value_type (value
));
834 const gdb_byte
*valaddr
= value_contents_for_printing (value
);
835 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
837 len
= type
->num_fields ();
838 val
= unpack_long (type
, valaddr
+ offset_aligned
);
839 for (i
= 0; i
< len
; i
++)
842 if (val
== TYPE_FIELD_ENUMVAL (type
, i
))
848 const char *name
= ada_enum_name (TYPE_FIELD_NAME (type
, i
));
851 fprintf_filtered (stream
, "%ld %ps", (long) val
,
852 styled_string (variable_name_style
.style (),
855 fputs_styled (name
, variable_name_style
.style (), stream
);
858 print_longest (stream
, 'd', 0, val
);
861 /* Implement Ada val_print'ing for the case where the type is
862 TYPE_CODE_STRUCT or TYPE_CODE_UNION. */
865 ada_val_print_struct_union (struct value
*value
,
866 struct ui_file
*stream
,
868 const struct value_print_options
*options
)
870 if (ada_is_bogus_array_descriptor (value_type (value
)))
872 fprintf_filtered (stream
, "(...?)");
876 fprintf_filtered (stream
, "(");
878 if (print_field_values (value
, value
, stream
, recurse
, options
,
879 0, language_def (language_ada
)) != 0
880 && options
->prettyformat
)
882 fprintf_filtered (stream
, "\n");
883 print_spaces_filtered (2 * recurse
, stream
);
886 fprintf_filtered (stream
, ")");
889 /* Implement Ada value_print'ing for the case where TYPE is a
893 ada_value_print_array (struct value
*val
, struct ui_file
*stream
, int recurse
,
894 const struct value_print_options
*options
)
896 struct type
*type
= ada_check_typedef (value_type (val
));
898 /* For an array of characters, print with string syntax. */
899 if (ada_is_string_type (type
)
900 && (options
->format
== 0 || options
->format
== 's'))
902 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
903 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
905 ada_val_print_string (type
, valaddr
, offset_aligned
, stream
, recurse
,
910 fprintf_filtered (stream
, "(");
911 print_optional_low_bound (stream
, type
, options
);
912 if (TYPE_FIELD_BITSIZE (type
, 0) > 0)
914 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
915 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
916 val_print_packed_array_elements (type
, valaddr
, offset_aligned
,
917 stream
, recurse
, options
);
920 value_print_array_elements (val
, stream
, recurse
, options
, 0);
921 fprintf_filtered (stream
, ")");
924 /* Implement Ada val_print'ing for the case where TYPE is
928 ada_val_print_ref (struct type
*type
, const gdb_byte
*valaddr
,
929 int offset
, int offset_aligned
, CORE_ADDR address
,
930 struct ui_file
*stream
, int recurse
,
931 struct value
*original_value
,
932 const struct value_print_options
*options
)
934 /* For references, the debugger is expected to print the value as
935 an address if DEREF_REF is null. But printing an address in place
936 of the object value would be confusing to an Ada programmer.
937 So, for Ada values, we print the actual dereferenced value
939 struct type
*elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
940 struct value
*deref_val
;
941 CORE_ADDR deref_val_int
;
943 if (elttype
->code () == TYPE_CODE_UNDEF
)
945 fputs_styled ("<ref to undefined type>", metadata_style
.style (),
950 deref_val
= coerce_ref_if_computed (original_value
);
953 if (ada_is_tagged_type (value_type (deref_val
), 1))
954 deref_val
= ada_tag_value_at_base_address (deref_val
);
956 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
957 language_def (language_ada
));
961 deref_val_int
= unpack_pointer (type
, valaddr
+ offset_aligned
);
962 if (deref_val_int
== 0)
964 fputs_filtered ("(null)", stream
);
969 = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype
),
971 if (ada_is_tagged_type (value_type (deref_val
), 1))
972 deref_val
= ada_tag_value_at_base_address (deref_val
);
974 /* Make sure that the object does not have an unreasonable size
975 before trying to print it. This can happen for instance with
976 references to dynamic objects whose contents is uninitialized
977 (Eg: an array whose bounds are not set yet). */
978 ada_ensure_varsize_limit (value_type (deref_val
));
980 if (value_lazy (deref_val
))
981 value_fetch_lazy (deref_val
);
983 common_val_print (deref_val
, stream
, recurse
+ 1,
984 options
, language_def (language_ada
));
987 /* See the comment on ada_value_print. This function differs in that
988 it does not catch evaluation errors (leaving that to
992 ada_value_print_1 (struct value
*val
, struct ui_file
*stream
, int recurse
,
993 const struct value_print_options
*options
)
995 struct type
*type
= ada_check_typedef (value_type (val
));
997 if (ada_is_array_descriptor_type (type
)
998 || (ada_is_constrained_packed_array_type (type
)
999 && type
->code () != TYPE_CODE_PTR
))
1001 /* If this is a reference, coerce it now. This helps taking
1002 care of the case where ADDRESS is meaningless because
1003 original_value was not an lval. */
1004 val
= coerce_ref (val
);
1005 val
= ada_get_decoded_value (val
);
1008 gdb_assert (type
->code () == TYPE_CODE_TYPEDEF
);
1009 fprintf_filtered (stream
, "0x0");
1014 val
= ada_to_fixed_value (val
);
1016 type
= value_type (val
);
1017 struct type
*saved_type
= type
;
1019 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
1020 CORE_ADDR address
= value_address (val
);
1021 gdb::array_view
<const gdb_byte
> view
1022 = gdb::make_array_view (valaddr
, TYPE_LENGTH (type
));
1023 type
= ada_check_typedef (resolve_dynamic_type (type
, view
, address
));
1024 if (type
!= saved_type
)
1026 val
= value_copy (val
);
1027 deprecated_set_value_type (val
, type
);
1030 if (is_fixed_point_type (type
))
1031 type
= fixed_point_type_base_type (type
);
1033 switch (type
->code ())
1036 common_val_print (val
, stream
, recurse
, options
,
1037 language_def (language_c
));
1041 ada_value_print_ptr (val
, stream
, recurse
, options
);
1045 case TYPE_CODE_RANGE
:
1046 ada_value_print_num (val
, stream
, recurse
, options
);
1049 case TYPE_CODE_ENUM
:
1050 ada_val_print_enum (val
, stream
, recurse
, options
);
1054 if (options
->format
)
1056 common_val_print (val
, stream
, recurse
, options
,
1057 language_def (language_c
));
1061 ada_print_floating (valaddr
, type
, stream
);
1064 case TYPE_CODE_UNION
:
1065 case TYPE_CODE_STRUCT
:
1066 ada_val_print_struct_union (val
, stream
, recurse
, options
);
1069 case TYPE_CODE_ARRAY
:
1070 ada_value_print_array (val
, stream
, recurse
, options
);
1074 ada_val_print_ref (type
, valaddr
, 0, 0,
1075 address
, stream
, recurse
, val
,
1081 /* See ada-lang.h. */
1084 ada_value_print_inner (struct value
*val
, struct ui_file
*stream
,
1086 const struct value_print_options
*options
)
1090 ada_value_print_1 (val
, stream
, recurse
, options
);
1092 catch (const gdb_exception_error
&except
)
1094 fprintf_styled (stream
, metadata_style
.style (),
1095 _("<error reading variable: %s>"),
1101 ada_value_print (struct value
*val0
, struct ui_file
*stream
,
1102 const struct value_print_options
*options
)
1104 struct value
*val
= ada_to_fixed_value (val0
);
1105 struct type
*type
= ada_check_typedef (value_type (val
));
1106 struct value_print_options opts
;
1108 /* If it is a pointer, indicate what it points to. */
1109 if (type
->code () == TYPE_CODE_PTR
)
1111 /* Hack: don't print (char *) for char strings. Their
1112 type is indicated by the quoted string anyway. */
1113 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) != sizeof (char)
1114 || TYPE_TARGET_TYPE (type
)->code () != TYPE_CODE_INT
1115 || TYPE_TARGET_TYPE (type
)->is_unsigned ())
1117 fprintf_filtered (stream
, "(");
1118 type_print (type
, "", stream
, -1);
1119 fprintf_filtered (stream
, ") ");
1122 else if (ada_is_array_descriptor_type (type
))
1124 /* We do not print the type description unless TYPE is an array
1125 access type (this is encoded by the compiler as a typedef to
1126 a fat pointer - hence the check against TYPE_CODE_TYPEDEF). */
1127 if (type
->code () == TYPE_CODE_TYPEDEF
)
1129 fprintf_filtered (stream
, "(");
1130 type_print (type
, "", stream
, -1);
1131 fprintf_filtered (stream
, ") ");
1134 else if (ada_is_bogus_array_descriptor (type
))
1136 fprintf_filtered (stream
, "(");
1137 type_print (type
, "", stream
, -1);
1138 fprintf_filtered (stream
, ") (...?)");
1144 common_val_print (val
, stream
, 0, &opts
, current_language
);