1 /* Support for printing Ada values for GDB, the GNU debugger.
3 Copyright (C) 1986-2023 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_BITSIZE (type
, 0);
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 struct value
*v0
, *v1
;
158 if (options
->prettyformat_arrays
)
160 gdb_printf (stream
, ",\n");
161 print_spaces (2 + 2 * recurse
, stream
);
165 gdb_printf (stream
, ", ");
168 else if (options
->prettyformat_arrays
)
170 gdb_printf (stream
, "\n");
171 print_spaces (2 + 2 * recurse
, stream
);
173 stream
->wrap_here (2 + 2 * recurse
);
174 maybe_print_array_index (index_type
, i
+ low
, stream
, options
);
177 v0
= ada_value_primitive_packed_val (NULL
, valaddr
+ offset
,
178 (i0
* bitsize
) / HOST_CHAR_BIT
,
179 (i0
* bitsize
) % HOST_CHAR_BIT
,
186 v1
= ada_value_primitive_packed_val (NULL
, valaddr
+ offset
,
187 (i
* bitsize
) / HOST_CHAR_BIT
,
188 (i
* bitsize
) % HOST_CHAR_BIT
,
190 if (check_typedef (v0
->type ())->length ()
191 != check_typedef (v1
->type ())->length ())
193 if (!v0
->contents_eq (v0
->embedded_offset (),
194 v1
, v1
->embedded_offset (),
195 check_typedef (v0
->type ())->length ()))
199 if (i
- i0
> options
->repeat_count_threshold
)
201 struct value_print_options opts
= *options
;
203 opts
.deref_ref
= false;
204 common_val_print (v0
, stream
, recurse
+ 1, &opts
, current_language
);
205 annotate_elt_rep (i
- i0
);
206 gdb_printf (stream
, _(" %p[<repeats %u times>%p]"),
207 metadata_style
.style ().ptr (), i
- i0
, nullptr);
208 annotate_elt_rep_end ();
214 struct value_print_options opts
= *options
;
216 opts
.deref_ref
= false;
217 for (j
= i0
; j
< i
; j
+= 1)
221 if (options
->prettyformat_arrays
)
223 gdb_printf (stream
, ",\n");
224 print_spaces (2 + 2 * recurse
, stream
);
228 gdb_printf (stream
, ", ");
230 stream
->wrap_here (2 + 2 * recurse
);
231 maybe_print_array_index (index_type
, j
+ low
,
234 common_val_print (v0
, stream
, recurse
+ 1, &opts
,
239 things_printed
+= i
- i0
;
241 annotate_array_section_end ();
244 gdb_printf (stream
, "...");
248 /* Print the character C on STREAM as part of the contents of a literal
249 string whose delimiter is QUOTER. TYPE_LEN is the length in bytes
253 ada_emit_char (int c
, struct type
*type
, struct ui_file
*stream
,
254 int quoter
, int type_len
)
256 /* If this character fits in the normal ASCII range, and is
257 a printable character, then print the character as if it was
258 an ASCII character, even if this is a wide character.
259 The UCHAR_MAX check is necessary because the isascii function
260 requires that its argument have a value of an unsigned char,
261 or EOF (EOF is obviously not printable). */
262 if (c
<= UCHAR_MAX
&& isascii (c
) && isprint (c
))
264 if (c
== quoter
&& c
== '"')
265 gdb_printf (stream
, "\"\"");
267 gdb_printf (stream
, "%c", c
);
271 /* Follow GNAT's lead here and only use 6 digits for
272 wide_wide_character. */
273 gdb_printf (stream
, "[\"%0*x\"]", std::min (6, type_len
* 2), c
);
277 /* Character #I of STRING, given that TYPE_LEN is the size in bytes
281 char_at (const gdb_byte
*string
, int i
, int type_len
,
282 enum bfd_endian byte_order
)
287 return (int) extract_unsigned_integer (string
+ type_len
* i
,
288 type_len
, byte_order
);
291 /* Print a floating-point value of type TYPE, pointed to in GDB by
292 VALADDR, on STREAM. Use Ada formatting conventions: there must be
293 a decimal point, and at least one digit before and after the
294 point. We use the GNAT format for NaNs and infinities. */
297 ada_print_floating (const gdb_byte
*valaddr
, struct type
*type
,
298 struct ui_file
*stream
)
300 string_file tmp_stream
;
302 print_floating (valaddr
, type
, &tmp_stream
);
304 std::string s
= tmp_stream
.release ();
305 size_t skip_count
= 0;
307 /* Don't try to modify a result representing an error. */
310 gdb_puts (s
.c_str (), stream
);
314 /* Modify for Ada rules. */
316 size_t pos
= s
.find ("inf");
317 if (pos
== std::string::npos
)
318 pos
= s
.find ("Inf");
319 if (pos
== std::string::npos
)
320 pos
= s
.find ("INF");
321 if (pos
!= std::string::npos
)
322 s
.replace (pos
, 3, "Inf");
324 if (pos
== std::string::npos
)
326 pos
= s
.find ("nan");
327 if (pos
== std::string::npos
)
328 pos
= s
.find ("NaN");
329 if (pos
== std::string::npos
)
330 pos
= s
.find ("Nan");
331 if (pos
!= std::string::npos
)
333 s
[pos
] = s
[pos
+ 2] = 'N';
339 if (pos
== std::string::npos
340 && s
.find ('.') == std::string::npos
)
343 if (pos
== std::string::npos
)
344 gdb_printf (stream
, "%s.0", s
.c_str ());
346 gdb_printf (stream
, "%.*s.0%s", (int) pos
, s
.c_str (), &s
[pos
]);
349 gdb_printf (stream
, "%s", &s
[skip_count
]);
353 ada_printchar (int c
, struct type
*type
, struct ui_file
*stream
)
355 gdb_puts ("'", stream
);
356 ada_emit_char (c
, type
, stream
, '\'', type
->length ());
357 gdb_puts ("'", stream
);
360 /* [From print_type_scalar in typeprint.c]. Print VAL on STREAM in a
361 form appropriate for TYPE, if non-NULL. If TYPE is NULL, print VAL
362 like a default signed integer. */
365 ada_print_scalar (struct type
*type
, LONGEST val
, struct ui_file
*stream
)
369 print_longest (stream
, 'd', 0, val
);
373 type
= ada_check_typedef (type
);
375 switch (type
->code ())
380 gdb::optional
<LONGEST
> posn
= discrete_position (type
, val
);
381 if (posn
.has_value ())
382 fputs_styled (ada_enum_name (type
->field (*posn
).name ()),
383 variable_name_style
.style (), stream
);
385 print_longest (stream
, 'd', 0, val
);
390 print_longest (stream
, type
->is_unsigned () ? 'u' : 'd', 0, val
);
394 current_language
->printchar (val
, type
, stream
);
398 gdb_printf (stream
, val
? "true" : "false");
401 case TYPE_CODE_RANGE
:
402 ada_print_scalar (type
->target_type (), val
, stream
);
405 case TYPE_CODE_UNDEF
:
407 case TYPE_CODE_ARRAY
:
408 case TYPE_CODE_STRUCT
:
409 case TYPE_CODE_UNION
:
414 case TYPE_CODE_STRING
:
415 case TYPE_CODE_ERROR
:
416 case TYPE_CODE_MEMBERPTR
:
417 case TYPE_CODE_METHODPTR
:
418 case TYPE_CODE_METHOD
:
420 warning (_("internal error: unhandled type in ada_print_scalar"));
424 error (_("Invalid type code in symbol table."));
428 /* Print the character string STRING, printing at most LENGTH characters.
429 Printing stops early if the number hits print_max; repeat counts
430 are printed as appropriate. Print ellipses at the end if we
431 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
432 TYPE_LEN is the length (1 or 2) of the character type. */
435 printstr (struct ui_file
*stream
, struct type
*elttype
, const gdb_byte
*string
,
436 unsigned int length
, int force_ellipses
, int type_len
,
437 const struct value_print_options
*options
)
439 enum bfd_endian byte_order
= type_byte_order (elttype
);
441 unsigned int things_printed
= 0;
447 gdb_puts ("\"\"", stream
);
451 unsigned int print_max_chars
= get_print_max_chars (options
);
452 for (i
= 0; i
< length
&& things_printed
< print_max_chars
; i
+= 1)
454 /* Position of the character we are examining
455 to see whether it is repeated. */
457 /* Number of repetitions we have detected so far. */
464 gdb_puts (", ", stream
);
471 && char_at (string
, rep1
, type_len
, byte_order
)
472 == char_at (string
, i
, type_len
, byte_order
))
478 if (reps
> options
->repeat_count_threshold
)
482 gdb_puts ("\", ", stream
);
485 gdb_puts ("'", stream
);
486 ada_emit_char (char_at (string
, i
, type_len
, byte_order
),
487 elttype
, stream
, '\'', type_len
);
488 gdb_puts ("'", stream
);
489 gdb_printf (stream
, _(" %p[<repeats %u times>%p]"),
490 metadata_style
.style ().ptr (), reps
, nullptr);
492 things_printed
+= options
->repeat_count_threshold
;
499 gdb_puts ("\"", stream
);
502 ada_emit_char (char_at (string
, i
, type_len
, byte_order
),
503 elttype
, stream
, '"', type_len
);
508 /* Terminate the quotes if necessary. */
510 gdb_puts ("\"", stream
);
512 if (force_ellipses
|| i
< length
)
513 gdb_puts ("...", stream
);
517 ada_printstr (struct ui_file
*stream
, struct type
*type
,
518 const gdb_byte
*string
, unsigned int length
,
519 const char *encoding
, int force_ellipses
,
520 const struct value_print_options
*options
)
522 printstr (stream
, type
, string
, length
, force_ellipses
, type
->length (),
527 print_variant_part (struct value
*value
, int field_num
,
528 struct value
*outer_value
,
529 struct ui_file
*stream
, int recurse
,
530 const struct value_print_options
*options
,
532 const struct language_defn
*language
)
534 struct type
*type
= value
->type ();
535 struct type
*var_type
= type
->field (field_num
).type ();
536 int which
= ada_which_variant_applies (var_type
, outer_value
);
541 struct value
*variant_field
= value_field (value
, field_num
);
542 struct value
*active_component
= value_field (variant_field
, which
);
543 return print_field_values (active_component
, outer_value
, stream
, recurse
,
544 options
, comma_needed
, language
);
547 /* Print out fields of VALUE.
549 STREAM, RECURSE, and OPTIONS have the same meanings as in
550 ada_print_value and ada_value_print.
552 OUTER_VALUE gives the enclosing record (used to get discriminant
553 values when printing variant parts).
555 COMMA_NEEDED is 1 if fields have been printed at the current recursion
556 level, so that a comma is needed before any field printed by this
559 Returns 1 if COMMA_NEEDED or any fields were printed. */
562 print_field_values (struct value
*value
, struct value
*outer_value
,
563 struct ui_file
*stream
, int recurse
,
564 const struct value_print_options
*options
,
566 const struct language_defn
*language
)
570 struct type
*type
= value
->type ();
571 len
= type
->num_fields ();
573 for (i
= 0; i
< len
; i
+= 1)
575 if (ada_is_ignored_field (type
, i
))
578 if (ada_is_wrapper_field (type
, i
))
580 struct value
*field_val
= ada_value_primitive_field (value
, 0,
583 print_field_values (field_val
, field_val
,
584 stream
, recurse
, options
,
585 comma_needed
, language
);
588 else if (ada_is_variant_part (type
, i
))
591 print_variant_part (value
, i
, outer_value
, stream
, recurse
,
592 options
, comma_needed
, language
);
597 gdb_printf (stream
, ", ");
600 if (options
->prettyformat
)
602 gdb_printf (stream
, "\n");
603 print_spaces (2 + 2 * recurse
, stream
);
607 stream
->wrap_here (2 + 2 * recurse
);
610 annotate_field_begin (type
->field (i
).type ());
611 gdb_printf (stream
, "%.*s",
612 ada_name_prefix_len (type
->field (i
).name ()),
613 type
->field (i
).name ());
614 annotate_field_name_end ();
615 gdb_puts (" => ", stream
);
616 annotate_field_value ();
618 if (TYPE_FIELD_PACKED (type
, i
))
620 /* Bitfields require special handling, especially due to byte
622 if (HAVE_CPLUS_STRUCT (type
) && TYPE_FIELD_IGNORE (type
, i
))
624 fputs_styled (_("<optimized out or zero length>"),
625 metadata_style
.style (), stream
);
630 int bit_pos
= type
->field (i
).loc_bitpos ();
631 int bit_size
= TYPE_FIELD_BITSIZE (type
, i
);
632 struct value_print_options opts
;
634 v
= ada_value_primitive_packed_val
636 bit_pos
/ HOST_CHAR_BIT
,
637 bit_pos
% HOST_CHAR_BIT
,
638 bit_size
, type
->field (i
).type ());
640 opts
.deref_ref
= false;
641 common_val_print (v
, stream
, recurse
+ 1, &opts
, language
);
646 struct value_print_options opts
= *options
;
648 opts
.deref_ref
= false;
650 struct value
*v
= value_field (value
, i
);
651 common_val_print (v
, stream
, recurse
+ 1, &opts
, language
);
653 annotate_field_end ();
659 /* Implement Ada val_print'ing for the case where TYPE is
660 a TYPE_CODE_ARRAY of characters. */
663 ada_val_print_string (struct type
*type
, const gdb_byte
*valaddr
,
665 struct ui_file
*stream
, int recurse
,
666 const struct value_print_options
*options
)
668 enum bfd_endian byte_order
= type_byte_order (type
);
669 struct type
*elttype
= type
->target_type ();
673 /* We know that ELTTYPE cannot possibly be null, because we assume
674 that we're called only when TYPE is a string-like type.
675 Similarly, the size of ELTTYPE should also be non-null, since
676 it's a character-like type. */
677 gdb_assert (elttype
!= NULL
);
678 gdb_assert (elttype
->length () != 0);
680 eltlen
= elttype
->length ();
681 len
= type
->length () / eltlen
;
683 /* If requested, look for the first null char and only print
684 elements up to it. */
685 if (options
->stop_print_at_null
)
687 unsigned int print_max_chars
= get_print_max_chars (options
);
690 /* Look for a NULL char. */
693 && temp_len
< print_max_chars
694 && char_at (valaddr
+ offset_aligned
,
695 temp_len
, eltlen
, byte_order
) != 0);
700 printstr (stream
, elttype
, valaddr
+ offset_aligned
, len
, 0,
704 /* Implement Ada value_print'ing for the case where TYPE is a
708 ada_value_print_ptr (struct value
*val
,
709 struct ui_file
*stream
, int recurse
,
710 const struct value_print_options
*options
)
713 && val
->type ()->target_type ()->code () == TYPE_CODE_INT
714 && val
->type ()->target_type ()->length () == 0)
716 gdb_puts ("null", stream
);
720 common_val_print (val
, stream
, recurse
, options
, language_def (language_c
));
722 struct type
*type
= ada_check_typedef (val
->type ());
723 if (ada_is_tag_type (type
))
725 gdb::unique_xmalloc_ptr
<char> name
= ada_tag_name (val
);
728 gdb_printf (stream
, " (%s)", name
.get ());
732 /* Implement Ada val_print'ing for the case where TYPE is
733 a TYPE_CODE_INT or TYPE_CODE_RANGE. */
736 ada_value_print_num (struct value
*val
, struct ui_file
*stream
, int recurse
,
737 const struct value_print_options
*options
)
739 struct type
*type
= ada_check_typedef (val
->type ());
740 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
742 if (type
->code () == TYPE_CODE_RANGE
743 && (type
->target_type ()->code () == TYPE_CODE_ENUM
744 || type
->target_type ()->code () == TYPE_CODE_BOOL
745 || type
->target_type ()->code () == TYPE_CODE_CHAR
))
747 /* For enum-valued ranges, we want to recurse, because we'll end
748 up printing the constant's name rather than its numeric
749 value. Character and fixed-point types are also printed
750 differently, so recuse for those as well. */
751 struct type
*target_type
= type
->target_type ();
752 val
= value_cast (target_type
, val
);
753 common_val_print (val
, stream
, recurse
+ 1, options
,
754 language_def (language_ada
));
759 int format
= (options
->format
? options
->format
760 : options
->output_format
);
764 struct value_print_options opts
= *options
;
766 opts
.format
= format
;
767 value_print_scalar_formatted (val
, &opts
, 0, stream
);
769 else if (ada_is_system_address_type (type
))
771 /* FIXME: We want to print System.Address variables using
772 the same format as for any access type. But for some
773 reason GNAT encodes the System.Address type as an int,
774 so we have to work-around this deficiency by handling
775 System.Address values as a special case. */
777 struct gdbarch
*gdbarch
= type
->arch ();
778 struct type
*ptr_type
= builtin_type (gdbarch
)->builtin_data_ptr
;
779 CORE_ADDR addr
= extract_typed_address (valaddr
, ptr_type
);
781 gdb_printf (stream
, "(");
782 type_print (type
, "", stream
, -1);
783 gdb_printf (stream
, ") ");
784 gdb_puts (paddress (gdbarch
, addr
), stream
);
788 value_print_scalar_formatted (val
, options
, 0, stream
);
789 if (ada_is_character_type (type
))
793 gdb_puts (" ", stream
);
794 c
= unpack_long (type
, valaddr
);
795 ada_printchar (c
, type
, stream
);
802 /* Implement Ada val_print'ing for the case where TYPE is
806 ada_val_print_enum (struct value
*value
, struct ui_file
*stream
, int recurse
,
807 const struct value_print_options
*options
)
813 value_print_scalar_formatted (value
, options
, 0, stream
);
817 struct type
*type
= ada_check_typedef (value
->type ());
818 const gdb_byte
*valaddr
= value
->contents_for_printing ().data ();
819 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
821 val
= unpack_long (type
, valaddr
+ offset_aligned
);
822 gdb::optional
<LONGEST
> posn
= discrete_position (type
, val
);
823 if (posn
.has_value ())
825 const char *name
= ada_enum_name (type
->field (*posn
).name ());
828 gdb_printf (stream
, "%ld %ps", (long) val
,
829 styled_string (variable_name_style
.style (),
832 fputs_styled (name
, variable_name_style
.style (), stream
);
835 print_longest (stream
, 'd', 0, val
);
838 /* Implement Ada val_print'ing for the case where the type is
839 TYPE_CODE_STRUCT or TYPE_CODE_UNION. */
842 ada_val_print_struct_union (struct value
*value
,
843 struct ui_file
*stream
,
845 const struct value_print_options
*options
)
847 if (ada_is_bogus_array_descriptor (value
->type ()))
849 gdb_printf (stream
, "(...?)");
853 gdb_printf (stream
, "(");
855 if (print_field_values (value
, value
, stream
, recurse
, options
,
856 0, language_def (language_ada
)) != 0
857 && options
->prettyformat
)
859 gdb_printf (stream
, "\n");
860 print_spaces (2 * recurse
, stream
);
863 gdb_printf (stream
, ")");
866 /* Implement Ada value_print'ing for the case where TYPE is a
870 ada_value_print_array (struct value
*val
, struct ui_file
*stream
, int recurse
,
871 const struct value_print_options
*options
)
873 struct type
*type
= ada_check_typedef (val
->type ());
875 /* For an array of characters, print with string syntax. */
876 if (ada_is_string_type (type
)
877 && (options
->format
== 0 || options
->format
== 's'))
879 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
880 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
882 ada_val_print_string (type
, valaddr
, offset_aligned
, stream
, recurse
,
887 gdb_printf (stream
, "(");
888 print_optional_low_bound (stream
, type
, options
);
890 if (val
->entirely_optimized_out ())
891 val_print_optimized_out (val
, stream
);
892 else if (TYPE_FIELD_BITSIZE (type
, 0) > 0)
894 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
895 int offset_aligned
= ada_aligned_value_addr (type
, valaddr
) - valaddr
;
896 val_print_packed_array_elements (type
, valaddr
, offset_aligned
,
897 stream
, recurse
, options
);
900 value_print_array_elements (val
, stream
, recurse
, options
, 0);
901 gdb_printf (stream
, ")");
904 /* Implement Ada val_print'ing for the case where TYPE is
908 ada_val_print_ref (struct type
*type
, const gdb_byte
*valaddr
,
909 int offset
, int offset_aligned
, CORE_ADDR address
,
910 struct ui_file
*stream
, int recurse
,
911 struct value
*original_value
,
912 const struct value_print_options
*options
)
914 /* For references, the debugger is expected to print the value as
915 an address if DEREF_REF is null. But printing an address in place
916 of the object value would be confusing to an Ada programmer.
917 So, for Ada values, we print the actual dereferenced value
919 struct type
*elttype
= check_typedef (type
->target_type ());
920 struct value
*deref_val
;
921 CORE_ADDR deref_val_int
;
923 if (elttype
->code () == TYPE_CODE_UNDEF
)
925 fputs_styled ("<ref to undefined type>", metadata_style
.style (),
930 deref_val
= coerce_ref_if_computed (original_value
);
933 if (ada_is_tagged_type (deref_val
->type (), 1))
934 deref_val
= ada_tag_value_at_base_address (deref_val
);
936 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
937 language_def (language_ada
));
941 deref_val_int
= unpack_pointer (type
, valaddr
+ offset_aligned
);
942 if (deref_val_int
== 0)
944 gdb_puts ("(null)", stream
);
949 = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype
),
951 if (ada_is_tagged_type (deref_val
->type (), 1))
952 deref_val
= ada_tag_value_at_base_address (deref_val
);
954 if (deref_val
->lazy ())
955 deref_val
->fetch_lazy ();
957 common_val_print (deref_val
, stream
, recurse
+ 1,
958 options
, language_def (language_ada
));
961 /* See the comment on ada_value_print. This function differs in that
962 it does not catch evaluation errors (leaving that to its
966 ada_value_print_inner (struct value
*val
, struct ui_file
*stream
, int recurse
,
967 const struct value_print_options
*options
)
969 struct type
*type
= ada_check_typedef (val
->type ());
971 if (ada_is_array_descriptor_type (type
)
972 || (ada_is_constrained_packed_array_type (type
)
973 && type
->code () != TYPE_CODE_PTR
))
975 /* If this is a reference, coerce it now. This helps taking
976 care of the case where ADDRESS is meaningless because
977 original_value was not an lval. */
978 val
= coerce_ref (val
);
979 val
= ada_get_decoded_value (val
);
982 gdb_assert (type
->code () == TYPE_CODE_TYPEDEF
);
983 gdb_printf (stream
, "0x0");
988 val
= ada_to_fixed_value (val
);
991 struct type
*saved_type
= type
;
993 const gdb_byte
*valaddr
= val
->contents_for_printing ().data ();
994 CORE_ADDR address
= val
->address ();
995 gdb::array_view
<const gdb_byte
> view
996 = gdb::make_array_view (valaddr
, type
->length ());
997 type
= ada_check_typedef (resolve_dynamic_type (type
, view
, address
));
998 if (type
!= saved_type
)
1001 val
->deprecated_set_type (type
);
1004 if (is_fixed_point_type (type
))
1005 type
= type
->fixed_point_type_base_type ();
1007 switch (type
->code ())
1010 common_val_print (val
, stream
, recurse
, options
,
1011 language_def (language_c
));
1015 ada_value_print_ptr (val
, stream
, recurse
, options
);
1019 case TYPE_CODE_RANGE
:
1020 ada_value_print_num (val
, stream
, recurse
, options
);
1023 case TYPE_CODE_ENUM
:
1024 ada_val_print_enum (val
, stream
, recurse
, options
);
1028 if (options
->format
)
1030 common_val_print (val
, stream
, recurse
, options
,
1031 language_def (language_c
));
1035 ada_print_floating (valaddr
, type
, stream
);
1038 case TYPE_CODE_UNION
:
1039 case TYPE_CODE_STRUCT
:
1040 ada_val_print_struct_union (val
, stream
, recurse
, options
);
1043 case TYPE_CODE_ARRAY
:
1044 ada_value_print_array (val
, stream
, recurse
, options
);
1048 ada_val_print_ref (type
, valaddr
, 0, 0,
1049 address
, stream
, recurse
, val
,
1056 ada_value_print (struct value
*val0
, struct ui_file
*stream
,
1057 const struct value_print_options
*options
)
1059 struct value
*val
= ada_to_fixed_value (val0
);
1060 struct type
*type
= ada_check_typedef (val
->type ());
1061 struct value_print_options opts
;
1063 /* If it is a pointer, indicate what it points to; but not for
1064 "void *" pointers. */
1065 if (type
->code () == TYPE_CODE_PTR
1066 && !(type
->target_type ()->code () == TYPE_CODE_INT
1067 && type
->target_type ()->length () == 0))
1069 /* Hack: don't print (char *) for char strings. Their
1070 type is indicated by the quoted string anyway. */
1071 if (type
->target_type ()->length () != sizeof (char)
1072 || type
->target_type ()->code () != TYPE_CODE_INT
1073 || type
->target_type ()->is_unsigned ())
1075 gdb_printf (stream
, "(");
1076 type_print (type
, "", stream
, -1);
1077 gdb_printf (stream
, ") ");
1080 else if (ada_is_array_descriptor_type (type
))
1082 /* We do not print the type description unless TYPE is an array
1083 access type (this is encoded by the compiler as a typedef to
1084 a fat pointer - hence the check against TYPE_CODE_TYPEDEF). */
1085 if (type
->code () == TYPE_CODE_TYPEDEF
)
1087 gdb_printf (stream
, "(");
1088 type_print (type
, "", stream
, -1);
1089 gdb_printf (stream
, ") ");
1092 else if (ada_is_bogus_array_descriptor (type
))
1094 gdb_printf (stream
, "(");
1095 type_print (type
, "", stream
, -1);
1096 gdb_printf (stream
, ") (...?)");
1101 opts
.deref_ref
= true;
1102 common_val_print (val
, stream
, 0, &opts
, current_language
);