1 /* Support for printing Ada values for GDB, the GNU debugger.
3 Copyright (C) 1986-2024 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 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
41 if non-standard (i.e., other than 1 for numbers, other than lower bound
42 of index type for enumerated type). Returns 1 if something printed,
46 print_optional_low_bound (struct ui_file
*stream
, struct type
*type
,
47 const struct value_print_options
*options
)
49 struct type
*index_type
;
53 if (options
->print_array_indexes
)
56 if (!get_array_bounds (type
, &low_bound
, &high_bound
))
59 /* If this is an empty array, then don't print the lower bound.
60 That would be confusing, because we would print the lower bound,
61 followed by... nothing! */
62 if (low_bound
> high_bound
)
65 index_type
= type
->index_type ();
67 while (index_type
->code () == TYPE_CODE_RANGE
)
69 /* We need to know what the base type is, in order to do the
70 appropriate check below. Otherwise, if this is a subrange
71 of an enumerated type, where the underlying value of the
72 first element is typically 0, we might test the low bound
73 against the wrong value. */
74 index_type
= index_type
->target_type ();
77 /* Don't print the lower bound if it's the default one. */
78 switch (index_type
->code ())
88 low_bound
= index_type
->field (low_bound
).loc_enumval ();
99 ada_print_scalar (index_type
, low_bound
, stream
);
100 gdb_printf (stream
, " => ");
104 /* Version of val_print_array_elements for GNAT-style packed arrays.
105 Prints elements of packed array of type TYPE from VALADDR on
106 STREAM. Formats according to OPTIONS and separates with commas.
107 RECURSE is the recursion (nesting) level. TYPE must have been
108 decoded (as by ada_coerce_to_simple_array). */
111 val_print_packed_array_elements (struct type
*type
, const gdb_byte
*valaddr
,
112 int offset
, struct ui_file
*stream
,
114 const struct value_print_options
*options
)
117 unsigned int things_printed
= 0;
119 struct type
*elttype
, *index_type
;
120 unsigned long bitsize
= type
->field (0).bitsize ();
123 scoped_value_mark mark
;
125 elttype
= type
->target_type ();
126 index_type
= type
->index_type ();
131 if (!get_discrete_bounds (index_type
, &low
, &high
))
135 /* The array length should normally be HIGH_POS - LOW_POS + 1.
136 But in Ada we allow LOW_POS to be greater than HIGH_POS for
137 empty arrays. In that situation, the array length is just zero,
142 len
= high
- low
+ 1;
145 if (index_type
->code () == TYPE_CODE_RANGE
)
146 index_type
= index_type
->target_type ();
149 annotate_array_section_begin (i
, elttype
);
151 while (i
< len
&& things_printed
< options
->print_max
)
153 /* Both this outer loop and the inner loop that checks for
154 duplicates may allocate many values. To avoid using too much
155 memory, both spots release values as they work. */
156 scoped_value_mark outer_free_values
;
158 struct value
*v0
, *v1
;
163 if (options
->prettyformat_arrays
)
165 gdb_printf (stream
, ",\n");
166 print_spaces (2 + 2 * recurse
, stream
);
170 gdb_printf (stream
, ", ");
173 else if (options
->prettyformat_arrays
)
175 gdb_printf (stream
, "\n");
176 print_spaces (2 + 2 * recurse
, stream
);
178 stream
->wrap_here (2 + 2 * recurse
);
179 maybe_print_array_index (index_type
, i
+ low
, stream
, options
);
182 v0
= ada_value_primitive_packed_val (NULL
, valaddr
+ offset
,
183 (i0
* bitsize
) / HOST_CHAR_BIT
,
184 (i0
* bitsize
) % HOST_CHAR_BIT
,
188 /* Make sure to free any values in the inner loop. */
189 scoped_value_mark free_values
;
194 v1
= ada_value_primitive_packed_val (NULL
, valaddr
+ offset
,
195 (i
* bitsize
) / HOST_CHAR_BIT
,
196 (i
* bitsize
) % HOST_CHAR_BIT
,
198 if (check_typedef (v0
->type ())->length ()
199 != check_typedef (v1
->type ())->length ())
201 if (!v0
->contents_eq (v0
->embedded_offset (),
202 v1
, v1
->embedded_offset (),
203 check_typedef (v0
->type ())->length ()))
207 if (i
- i0
> options
->repeat_count_threshold
)
209 struct value_print_options opts
= *options
;
211 opts
.deref_ref
= false;
212 common_val_print (v0
, stream
, recurse
+ 1, &opts
, current_language
);
213 annotate_elt_rep (i
- i0
);
214 gdb_printf (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
;
224 opts
.deref_ref
= false;
225 for (j
= i0
; j
< i
; j
+= 1)
229 if (options
->prettyformat_arrays
)
231 gdb_printf (stream
, ",\n");
232 print_spaces (2 + 2 * recurse
, stream
);
236 gdb_printf (stream
, ", ");
238 stream
->wrap_here (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 gdb_printf (stream
, "...");
256 /* Print the character C on STREAM as part of the contents of a literal
257 string whose delimiter is QUOTER. TYPE_LEN is the length in bytes
261 ada_emit_char (int c
, struct type
*type
, struct ui_file
*stream
,
262 int quoter
, int type_len
)
264 /* If this character fits in the normal ASCII range, and is
265 a printable character, then print the character as if it was
266 an ASCII character, even if this is a wide character.
267 The UCHAR_MAX check is necessary because the isascii function
268 requires that its argument have a value of an unsigned char,
269 or EOF (EOF is obviously not printable). */
270 if (c
<= UCHAR_MAX
&& isascii (c
) && isprint (c
))
272 if (c
== quoter
&& c
== '"')
273 gdb_printf (stream
, "\"\"");
275 gdb_printf (stream
, "%c", c
);
279 /* Follow GNAT's lead here and only use 6 digits for
280 wide_wide_character. */
281 gdb_printf (stream
, "[\"%0*x\"]", std::min (6, type_len
* 2), c
);
285 /* Character #I of STRING, given that TYPE_LEN is the size in bytes
289 char_at (const gdb_byte
*string
, int i
, int type_len
,
290 enum bfd_endian byte_order
)
295 return (int) extract_unsigned_integer (string
+ type_len
* i
,
296 type_len
, byte_order
);
299 /* Print a floating-point value of type TYPE, pointed to in GDB by
300 VALADDR, on STREAM. Use Ada formatting conventions: there must be
301 a decimal point, and at least one digit before and after the
302 point. We use the GNAT format for NaNs and infinities. */
305 ada_print_floating (const gdb_byte
*valaddr
, struct type
*type
,
306 struct ui_file
*stream
)
308 string_file tmp_stream
;
310 print_floating (valaddr
, type
, &tmp_stream
);
312 std::string s
= tmp_stream
.release ();
313 size_t skip_count
= 0;
315 /* Don't try to modify a result representing an error. */
318 gdb_puts (s
.c_str (), stream
);
322 /* Modify for Ada rules. */
324 size_t pos
= s
.find ("inf");
325 if (pos
== std::string::npos
)
326 pos
= s
.find ("Inf");
327 if (pos
== std::string::npos
)
328 pos
= s
.find ("INF");
329 if (pos
!= std::string::npos
)
330 s
.replace (pos
, 3, "Inf");
332 if (pos
== std::string::npos
)
334 pos
= s
.find ("nan");
335 if (pos
== std::string::npos
)
336 pos
= s
.find ("NaN");
337 if (pos
== std::string::npos
)
338 pos
= s
.find ("Nan");
339 if (pos
!= std::string::npos
)
341 s
[pos
] = s
[pos
+ 2] = 'N';
347 if (pos
== std::string::npos
348 && s
.find ('.') == std::string::npos
)
351 if (pos
== std::string::npos
)
352 gdb_printf (stream
, "%s.0", s
.c_str ());
354 gdb_printf (stream
, "%.*s.0%s", (int) pos
, s
.c_str (), &s
[pos
]);
357 gdb_printf (stream
, "%s", &s
[skip_count
]);
361 ada_printchar (int c
, struct type
*type
, struct ui_file
*stream
)
363 gdb_puts ("'", stream
);
364 ada_emit_char (c
, type
, stream
, '\'', type
->length ());
365 gdb_puts ("'", stream
);
368 /* [From print_type_scalar in typeprint.c]. Print VAL on STREAM in a
369 form appropriate for TYPE, if non-NULL. If TYPE is NULL, print VAL
370 like a default signed integer. */
373 ada_print_scalar (struct type
*type
, LONGEST val
, struct ui_file
*stream
)
377 print_longest (stream
, 'd', 0, val
);
381 type
= ada_check_typedef (type
);
383 switch (type
->code ())
388 std::optional
<LONGEST
> posn
= discrete_position (type
, val
);
389 if (posn
.has_value ())
390 fputs_styled (ada_enum_name (type
->field (*posn
).name ()),
391 variable_name_style
.style (), stream
);
393 print_longest (stream
, 'd', 0, val
);
398 print_longest (stream
, type
->is_unsigned () ? 'u' : 'd', 0, val
);
402 current_language
->printchar (val
, type
, stream
);
406 gdb_printf (stream
, val
? "true" : "false");
409 case TYPE_CODE_RANGE
:
410 ada_print_scalar (type
->target_type (), val
, stream
);
413 case TYPE_CODE_UNDEF
:
415 case TYPE_CODE_ARRAY
:
416 case TYPE_CODE_STRUCT
:
417 case TYPE_CODE_UNION
:
422 case TYPE_CODE_STRING
:
423 case TYPE_CODE_ERROR
:
424 case TYPE_CODE_MEMBERPTR
:
425 case TYPE_CODE_METHODPTR
:
426 case TYPE_CODE_METHOD
:
428 warning (_("internal error: unhandled type in ada_print_scalar"));
432 error (_("Invalid type code in symbol table."));
436 /* Print the character string STRING, printing at most LENGTH characters.
437 Printing stops early if the number hits print_max; repeat counts
438 are printed as appropriate. Print ellipses at the end if we
439 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
440 TYPE_LEN is the length (1 or 2) of the character type. */
443 printstr (struct ui_file
*stream
, struct type
*elttype
, const gdb_byte
*string
,
444 unsigned int length
, int force_ellipses
, int type_len
,
445 const struct value_print_options
*options
)
447 enum bfd_endian byte_order
= type_byte_order (elttype
);
449 unsigned int things_printed
= 0;
455 gdb_puts ("\"\"", stream
);
459 unsigned int print_max_chars
= get_print_max_chars (options
);
460 for (i
= 0; i
< length
&& things_printed
< print_max_chars
; i
+= 1)
462 /* Position of the character we are examining
463 to see whether it is repeated. */
465 /* Number of repetitions we have detected so far. */
472 gdb_puts (", ", stream
);
479 && char_at (string
, rep1
, type_len
, byte_order
)
480 == char_at (string
, i
, type_len
, byte_order
))
486 if (reps
> options
->repeat_count_threshold
)
490 gdb_puts ("\", ", stream
);
493 gdb_puts ("'", stream
);
494 ada_emit_char (char_at (string
, i
, type_len
, byte_order
),
495 elttype
, stream
, '\'', type_len
);
496 gdb_puts ("'", stream
);
497 gdb_printf (stream
, _(" %p[<repeats %u times>%p]"),
498 metadata_style
.style ().ptr (), reps
, nullptr);
500 things_printed
+= options
->repeat_count_threshold
;
507 gdb_puts ("\"", stream
);
510 ada_emit_char (char_at (string
, i
, type_len
, byte_order
),
511 elttype
, stream
, '"', type_len
);
516 /* Terminate the quotes if necessary. */
518 gdb_puts ("\"", stream
);
520 if (force_ellipses
|| i
< length
)
521 gdb_puts ("...", stream
);
525 ada_printstr (struct ui_file
*stream
, struct type
*type
,
526 const gdb_byte
*string
, unsigned int length
,
527 const char *encoding
, int force_ellipses
,
528 const struct value_print_options
*options
)
530 printstr (stream
, type
, string
, length
, force_ellipses
, type
->length (),
535 print_variant_part (struct value
*value
, int field_num
,
536 struct value
*outer_value
,
537 struct ui_file
*stream
, int recurse
,
538 const struct value_print_options
*options
,
540 const struct language_defn
*language
)
542 struct type
*type
= value
->type ();
543 struct type
*var_type
= type
->field (field_num
).type ();
544 int which
= ada_which_variant_applies (var_type
, outer_value
);
549 struct value
*variant_field
= value_field (value
, field_num
);
550 struct value
*active_component
= value_field (variant_field
, which
);
551 return print_field_values (active_component
, outer_value
, stream
, recurse
,
552 options
, comma_needed
, language
);
555 /* Print out fields of VALUE.
557 STREAM, RECURSE, and OPTIONS have the same meanings as in
558 ada_print_value and ada_value_print.
560 OUTER_VALUE gives the enclosing record (used to get discriminant
561 values when printing variant parts).
563 COMMA_NEEDED is 1 if fields have been printed at the current recursion
564 level, so that a comma is needed before any field printed by this
567 Returns 1 if COMMA_NEEDED or any fields were printed. */
570 print_field_values (struct value
*value
, struct value
*outer_value
,
571 struct ui_file
*stream
, int recurse
,
572 const struct value_print_options
*options
,
574 const struct language_defn
*language
)
578 struct type
*type
= value
->type ();
579 len
= type
->num_fields ();
581 for (i
= 0; i
< len
; i
+= 1)
583 if (ada_is_ignored_field (type
, i
))
586 if (ada_is_wrapper_field (type
, i
))
588 struct value
*field_val
= ada_value_primitive_field (value
, 0,
591 print_field_values (field_val
, field_val
,
592 stream
, recurse
, options
,
593 comma_needed
, language
);
596 else if (ada_is_variant_part (type
, i
))
599 print_variant_part (value
, i
, outer_value
, stream
, recurse
,
600 options
, comma_needed
, language
);
605 gdb_printf (stream
, ", ");
608 if (options
->prettyformat
)
610 gdb_printf (stream
, "\n");
611 print_spaces (2 + 2 * recurse
, stream
);
615 stream
->wrap_here (2 + 2 * recurse
);
618 annotate_field_begin (type
->field (i
).type ());
619 gdb_printf (stream
, "%.*s",
620 ada_name_prefix_len (type
->field (i
).name ()),
621 type
->field (i
).name ());
622 annotate_field_name_end ();
623 gdb_puts (" => ", stream
);
624 annotate_field_value ();
626 if (type
->field (i
).is_packed ())
628 /* Bitfields require special handling, especially due to byte
630 if (type
->field (i
).is_ignored ())
632 fputs_styled (_("<optimized out or zero length>"),
633 metadata_style
.style (), stream
);
638 int bit_pos
= type
->field (i
).loc_bitpos ();
639 int bit_size
= type
->field (i
).bitsize ();
640 struct value_print_options opts
;
642 v
= ada_value_primitive_packed_val
644 bit_pos
/ HOST_CHAR_BIT
,
645 bit_pos
% HOST_CHAR_BIT
,
646 bit_size
, type
->field (i
).type ());
648 opts
.deref_ref
= false;
649 common_val_print (v
, stream
, recurse
+ 1, &opts
, language
);
654 struct value_print_options opts
= *options
;
656 opts
.deref_ref
= false;
658 struct value
*v
= value_field (value
, i
);
659 common_val_print (v
, stream
, recurse
+ 1, &opts
, language
);
661 annotate_field_end ();
667 /* Implement Ada val_print'ing for the case where TYPE is
668 a TYPE_CODE_ARRAY of characters. */
671 ada_val_print_string (struct type
*type
, const gdb_byte
*valaddr
,
673 struct ui_file
*stream
, int recurse
,
674 const struct value_print_options
*options
)
676 enum bfd_endian byte_order
= type_byte_order (type
);
677 struct type
*elttype
= type
->target_type ();
681 /* We know that ELTTYPE cannot possibly be null, because we assume
682 that we're called only when TYPE is a string-like type.
683 Similarly, the size of ELTTYPE should also be non-null, since
684 it's a character-like type. */
685 gdb_assert (elttype
!= NULL
);
686 gdb_assert (elttype
->length () != 0);
688 eltlen
= elttype
->length ();
689 len
= type
->length () / eltlen
;
691 /* If requested, look for the first null char and only print
692 elements up to it. */
693 if (options
->stop_print_at_null
)
695 unsigned int print_max_chars
= get_print_max_chars (options
);
698 /* Look for a NULL char. */
701 && temp_len
< print_max_chars
702 && char_at (valaddr
+ offset_aligned
,
703 temp_len
, eltlen
, byte_order
) != 0);
708 printstr (stream
, elttype
, valaddr
+ offset_aligned
, len
, 0,
712 /* Implement Ada value_print'ing for the case where TYPE is a
716 ada_value_print_ptr (struct value
*val
,
717 struct ui_file
*stream
, int recurse
,
718 const struct value_print_options
*options
)
721 && val
->type ()->target_type ()->code () == TYPE_CODE_INT
722 && val
->type ()->target_type ()->length () == 0)
724 gdb_puts ("null", stream
);
728 common_val_print (val
, stream
, recurse
, options
, language_def (language_c
));
730 struct type
*type
= ada_check_typedef (val
->type ());
731 if (ada_is_tag_type (type
))
733 gdb::unique_xmalloc_ptr
<char> name
= ada_tag_name (val
);
736 gdb_printf (stream
, " (%s)", name
.get ());
740 /* Implement Ada val_print'ing for the case where TYPE is
741 a TYPE_CODE_INT or TYPE_CODE_RANGE. */
744 ada_value_print_num (struct value
*val
, struct ui_file
*stream
, int recurse
,
745 const struct value_print_options
*options
)
747 struct type
*type
= ada_check_typedef (val
->type ());
748 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
750 if (type
->code () == TYPE_CODE_RANGE
751 && (type
->target_type ()->code () == TYPE_CODE_ENUM
752 || type
->target_type ()->code () == TYPE_CODE_BOOL
753 || type
->target_type ()->code () == TYPE_CODE_CHAR
))
755 /* For enum-valued ranges, we want to recurse, because we'll end
756 up printing the constant's name rather than its numeric
757 value. Character and fixed-point types are also printed
758 differently, so recurse for those as well. */
759 struct type
*target_type
= type
->target_type ();
760 val
= value_cast (target_type
, val
);
761 common_val_print (val
, stream
, recurse
+ 1, options
,
762 language_def (language_ada
));
767 int format
= (options
->format
? options
->format
768 : options
->output_format
);
772 struct value_print_options opts
= *options
;
774 opts
.format
= format
;
775 value_print_scalar_formatted (val
, &opts
, 0, stream
);
777 else if (ada_is_system_address_type (type
))
779 /* FIXME: We want to print System.Address variables using
780 the same format as for any access type. But for some
781 reason GNAT encodes the System.Address type as an int,
782 so we have to work-around this deficiency by handling
783 System.Address values as a special case. */
785 struct gdbarch
*gdbarch
= type
->arch ();
786 struct type
*ptr_type
= builtin_type (gdbarch
)->builtin_data_ptr
;
787 CORE_ADDR addr
= extract_typed_address (valaddr
, ptr_type
);
789 gdb_printf (stream
, "(");
790 type_print (type
, "", stream
, -1);
791 gdb_printf (stream
, ") ");
792 gdb_puts (paddress (gdbarch
, addr
), stream
);
796 value_print_scalar_formatted (val
, options
, 0, stream
);
797 if (ada_is_character_type (type
))
801 gdb_puts (" ", stream
);
802 c
= unpack_long (type
, valaddr
);
803 ada_printchar (c
, type
, stream
);
810 /* Implement Ada val_print'ing for the case where TYPE is
814 ada_val_print_enum (struct value
*value
, struct ui_file
*stream
, int recurse
,
815 const struct value_print_options
*options
)
821 value_print_scalar_formatted (value
, options
, 0, stream
);
825 struct type
*type
= ada_check_typedef (value
->type ());
826 const gdb_byte
*valaddr
= value
->contents_for_printing ().data ();
827 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
829 val
= unpack_long (type
, valaddr
+ offset_aligned
);
830 std::optional
<LONGEST
> posn
= discrete_position (type
, val
);
831 if (posn
.has_value ())
833 const char *name
= ada_enum_name (type
->field (*posn
).name ());
836 gdb_printf (stream
, "%ld %ps", (long) val
,
837 styled_string (variable_name_style
.style (),
840 fputs_styled (name
, variable_name_style
.style (), stream
);
843 print_longest (stream
, 'd', 0, val
);
846 /* Implement Ada val_print'ing for the case where the type is
847 TYPE_CODE_STRUCT or TYPE_CODE_UNION. */
850 ada_val_print_struct_union (struct value
*value
,
851 struct ui_file
*stream
,
853 const struct value_print_options
*options
)
855 gdb_printf (stream
, "(");
857 if (print_field_values (value
, value
, stream
, recurse
, options
,
858 0, language_def (language_ada
)) != 0
859 && options
->prettyformat
)
861 gdb_printf (stream
, "\n");
862 print_spaces (2 * recurse
, stream
);
865 gdb_printf (stream
, ")");
868 /* Implement Ada value_print'ing for the case where TYPE is a
872 ada_value_print_array (struct value
*val
, struct ui_file
*stream
, int recurse
,
873 const struct value_print_options
*options
)
875 struct type
*type
= ada_check_typedef (val
->type ());
877 /* For an array of characters, print with string syntax. */
878 if (ada_is_string_type (type
)
879 && (options
->format
== 0 || options
->format
== 's'))
881 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
882 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
884 ada_val_print_string (type
, valaddr
, offset_aligned
, stream
, recurse
,
889 gdb_printf (stream
, "(");
890 print_optional_low_bound (stream
, type
, options
);
892 if (val
->entirely_optimized_out ())
893 val_print_optimized_out (val
, stream
);
894 else if (type
->field (0).bitsize () > 0)
896 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
897 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
898 val_print_packed_array_elements (type
, valaddr
, offset_aligned
,
899 stream
, recurse
, options
);
902 value_print_array_elements (val
, stream
, recurse
, options
, 0);
903 gdb_printf (stream
, ")");
906 /* Implement Ada val_print'ing for the case where TYPE is
910 ada_val_print_ref (struct type
*type
, const gdb_byte
*valaddr
,
911 int offset
, int offset_aligned
, CORE_ADDR address
,
912 struct ui_file
*stream
, int recurse
,
913 struct value
*original_value
,
914 const struct value_print_options
*options
)
916 /* For references, the debugger is expected to print the value as
917 an address if DEREF_REF is null. But printing an address in place
918 of the object value would be confusing to an Ada programmer.
919 So, for Ada values, we print the actual dereferenced value
921 struct type
*elttype
= check_typedef (type
->target_type ());
922 struct value
*deref_val
;
923 CORE_ADDR deref_val_int
;
925 if (elttype
->code () == TYPE_CODE_UNDEF
)
927 fputs_styled ("<ref to undefined type>", metadata_style
.style (),
932 deref_val
= coerce_ref_if_computed (original_value
);
935 if (ada_is_tagged_type (deref_val
->type (), 1))
936 deref_val
= ada_tag_value_at_base_address (deref_val
);
938 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
939 language_def (language_ada
));
943 deref_val_int
= unpack_pointer (type
, valaddr
+ offset_aligned
);
944 if (deref_val_int
== 0)
946 gdb_puts ("(null)", stream
);
951 = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype
),
953 if (ada_is_tagged_type (deref_val
->type (), 1))
954 deref_val
= ada_tag_value_at_base_address (deref_val
);
956 if (deref_val
->lazy ())
957 deref_val
->fetch_lazy ();
959 common_val_print (deref_val
, stream
, recurse
+ 1,
960 options
, language_def (language_ada
));
963 /* See the comment on ada_value_print. This function differs in that
964 it does not catch evaluation errors (leaving that to its
968 ada_value_print_inner (struct value
*val
, struct ui_file
*stream
, int recurse
,
969 const struct value_print_options
*options
)
971 struct type
*type
= ada_check_typedef (val
->type ());
973 if (ada_is_array_descriptor_type (type
)
974 || (ada_is_constrained_packed_array_type (type
)
975 && type
->code () != TYPE_CODE_PTR
))
977 /* If this is a reference, coerce it now. This helps taking
978 care of the case where ADDRESS is meaningless because
979 original_value was not an lval. */
980 val
= coerce_ref (val
);
981 val
= ada_get_decoded_value (val
);
984 gdb_assert (type
->code () == TYPE_CODE_TYPEDEF
);
985 gdb_printf (stream
, "0x0");
990 val
= ada_to_fixed_value (val
);
993 struct type
*saved_type
= type
;
995 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
996 CORE_ADDR address
= val
->address ();
997 gdb::array_view
<const gdb_byte
> view
998 = gdb::make_array_view (valaddr
, type
->length ());
999 type
= ada_check_typedef (resolve_dynamic_type (type
, view
, address
));
1000 if (type
!= saved_type
)
1003 val
->deprecated_set_type (type
);
1006 if (is_fixed_point_type (type
))
1007 type
= type
->fixed_point_type_base_type ();
1009 switch (type
->code ())
1012 common_val_print (val
, stream
, recurse
, options
,
1013 language_def (language_c
));
1017 ada_value_print_ptr (val
, stream
, recurse
, options
);
1021 case TYPE_CODE_RANGE
:
1022 ada_value_print_num (val
, stream
, recurse
, options
);
1025 case TYPE_CODE_ENUM
:
1026 ada_val_print_enum (val
, stream
, recurse
, options
);
1030 if (options
->format
)
1032 common_val_print (val
, stream
, recurse
, options
,
1033 language_def (language_c
));
1037 ada_print_floating (valaddr
, type
, stream
);
1040 case TYPE_CODE_UNION
:
1041 case TYPE_CODE_STRUCT
:
1042 ada_val_print_struct_union (val
, stream
, recurse
, options
);
1045 case TYPE_CODE_ARRAY
:
1046 ada_value_print_array (val
, stream
, recurse
, options
);
1050 ada_val_print_ref (type
, valaddr
, 0, 0,
1051 address
, stream
, recurse
, val
,
1058 ada_value_print (struct value
*val0
, struct ui_file
*stream
,
1059 const struct value_print_options
*options
)
1061 struct value
*val
= ada_to_fixed_value (val0
);
1062 struct type
*type
= ada_check_typedef (val
->type ());
1063 struct value_print_options opts
;
1065 /* If it is a pointer, indicate what it points to; but not for
1066 "void *" pointers. */
1067 if (type
->code () == TYPE_CODE_PTR
1068 && !(type
->target_type ()->code () == TYPE_CODE_INT
1069 && type
->target_type ()->length () == 0))
1071 /* Hack: don't print (char *) for char strings. Their
1072 type is indicated by the quoted string anyway. */
1073 if (type
->target_type ()->length () != sizeof (char)
1074 || type
->target_type ()->code () != TYPE_CODE_INT
1075 || type
->target_type ()->is_unsigned ())
1077 gdb_printf (stream
, "(");
1078 type_print (type
, "", stream
, -1);
1079 gdb_printf (stream
, ") ");
1082 else if (ada_is_array_descriptor_type (type
))
1084 /* We do not print the type description unless TYPE is an array
1085 access type (this is encoded by the compiler as a typedef to
1086 a fat pointer - hence the check against TYPE_CODE_TYPEDEF). */
1087 if (type
->code () == TYPE_CODE_TYPEDEF
)
1089 gdb_printf (stream
, "(");
1090 type_print (type
, "", stream
, -1);
1091 gdb_printf (stream
, ") ");
1096 opts
.deref_ref
= true;
1097 common_val_print (val
, stream
, 0, &opts
, current_language
);