Update NEWS post GDB 10 branch creation.
[binutils-gdb.git] / gdb / ada-valprint.c
blob6a5b7d3f37aac30d7e3fed5a3def0b818bee8763
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/>. */
20 #include "defs.h"
21 #include <ctype.h>
22 #include "gdbtypes.h"
23 #include "expression.h"
24 #include "value.h"
25 #include "valprint.h"
26 #include "language.h"
27 #include "annotate.h"
28 #include "ada-lang.h"
29 #include "target-float.h"
30 #include "cli/cli-style.h"
31 #include "gdbarch.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. */
41 static void
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_UNSIGNED (type) = 1;
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,
52 otherwise 0. */
54 static int
55 print_optional_low_bound (struct ui_file *stream, struct type *type,
56 const struct value_print_options *options)
58 struct type *index_type;
59 LONGEST low_bound;
60 LONGEST high_bound;
62 if (options->print_array_indexes)
63 return 0;
65 if (!get_array_bounds (type, &low_bound, &high_bound))
66 return 0;
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)
72 return 0;
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 ())
89 case TYPE_CODE_BOOL:
90 case TYPE_CODE_CHAR:
91 if (low_bound == 0)
92 return 0;
93 break;
94 case TYPE_CODE_ENUM:
95 if (low_bound == 0)
96 return 0;
97 low_bound = TYPE_FIELD_ENUMVAL (index_type, low_bound);
98 break;
99 case TYPE_CODE_UNDEF:
100 index_type = NULL;
101 /* FALL THROUGH */
102 default:
103 if (low_bound == 1)
104 return 0;
105 break;
108 ada_print_scalar (index_type, low_bound, stream);
109 fprintf_filtered (stream, " => ");
110 return 1;
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). */
119 static void
120 val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
121 int offset, struct ui_file *stream,
122 int recurse,
123 const struct value_print_options *options)
125 unsigned int i;
126 unsigned int things_printed = 0;
127 unsigned len;
128 struct type *elttype, *index_type;
129 unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
130 struct value *mark = value_mark ();
131 LONGEST low = 0;
133 elttype = TYPE_TARGET_TYPE (type);
134 index_type = type->index_type ();
137 LONGEST high;
139 if (get_discrete_bounds (index_type, &low, &high) < 0)
140 len = 1;
141 else if (low > high)
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,
146 not negative! */
147 len = 0;
149 else
150 len = high - low + 1;
153 if (index_type->code () == TYPE_CODE_RANGE)
154 index_type = TYPE_TARGET_TYPE (index_type);
156 i = 0;
157 annotate_array_section_begin (i, elttype);
159 while (i < len && things_printed < options->print_max)
161 struct value *v0, *v1;
162 int i0;
164 if (i != 0)
166 if (options->prettyformat_arrays)
168 fprintf_filtered (stream, ",\n");
169 print_spaces_filtered (2 + 2 * recurse, stream);
171 else
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);
184 i0 = i;
185 v0 = ada_value_primitive_packed_val (NULL, valaddr + offset,
186 (i0 * bitsize) / HOST_CHAR_BIT,
187 (i0 * bitsize) % HOST_CHAR_BIT,
188 bitsize, elttype);
189 while (1)
191 i += 1;
192 if (i >= len)
193 break;
194 v1 = ada_value_primitive_packed_val (NULL, valaddr + offset,
195 (i * bitsize) / HOST_CHAR_BIT,
196 (i * bitsize) % HOST_CHAR_BIT,
197 bitsize, elttype);
198 if (TYPE_LENGTH (check_typedef (value_type (v0)))
199 != TYPE_LENGTH (check_typedef (value_type (v1))))
200 break;
201 if (!value_contents_eq (v0, value_embedded_offset (v0),
202 v1, value_embedded_offset (v1),
203 TYPE_LENGTH (check_typedef (value_type (v0)))))
204 break;
207 if (i - i0 > options->repeat_count_threshold)
209 struct value_print_options opts = *options;
211 opts.deref_ref = 0;
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 ();
219 else
221 int j;
222 struct value_print_options opts = *options;
224 opts.deref_ref = 0;
225 for (j = i0; j < i; j += 1)
227 if (j > i0)
229 if (options->prettyformat_arrays)
231 fprintf_filtered (stream, ",\n");
232 print_spaces_filtered (2 + 2 * recurse, stream);
234 else
236 fprintf_filtered (stream, ", ");
238 wrap_here (n_spaces (2 + 2 * recurse));
239 maybe_print_array_index (index_type, j + low,
240 stream, options);
242 common_val_print (v0, stream, recurse + 1, &opts,
243 current_language);
244 annotate_elt ();
247 things_printed += i - i0;
249 annotate_array_section_end ();
250 if (i < len)
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
260 of the character. */
262 void
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, "\"\"");
276 else
277 fprintf_filtered (stream, "%c", c);
279 else
280 fprintf_filtered (stream, "[\"%0*x\"]", type_len * 2, c);
283 /* Character #I of STRING, given that TYPE_LEN is the size in bytes
284 of a character. */
286 static int
287 char_at (const gdb_byte *string, int i, int type_len,
288 enum bfd_endian byte_order)
290 if (type_len == 1)
291 return string[i];
292 else
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. */
302 static void
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';
333 if (s[0] == '-')
334 skip_count = 1;
338 if (pos == std::string::npos
339 && s.find ('.') == std::string::npos)
341 pos = s.find ('e');
342 if (pos == std::string::npos)
343 fprintf_filtered (stream, "%s.0", s.c_str ());
344 else
345 fprintf_filtered (stream, "%.*s.0%s", (int) pos, s.c_str (), &s[pos]);
347 else
348 fprintf_filtered (stream, "%s", &s[skip_count]);
351 void
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. */
363 void
364 ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
366 unsigned int i;
367 unsigned len;
369 if (!type)
371 print_longest (stream, 'd', 0, val);
372 return;
375 type = ada_check_typedef (type);
377 switch (type->code ())
380 case TYPE_CODE_ENUM:
381 len = type->num_fields ();
382 for (i = 0; i < len; i++)
384 if (TYPE_FIELD_ENUMVAL (type, i) == val)
386 break;
389 if (i < len)
391 fputs_styled (ada_enum_name (TYPE_FIELD_NAME (type, i)),
392 variable_name_style.style (), stream);
394 else
396 print_longest (stream, 'd', 0, val);
398 break;
400 case TYPE_CODE_INT:
401 print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
402 break;
404 case TYPE_CODE_CHAR:
405 LA_PRINT_CHAR (val, type, stream);
406 break;
408 case TYPE_CODE_BOOL:
409 fprintf_filtered (stream, val ? "true" : "false");
410 break;
412 case TYPE_CODE_RANGE:
413 ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
414 return;
416 case TYPE_CODE_UNDEF:
417 case TYPE_CODE_PTR:
418 case TYPE_CODE_ARRAY:
419 case TYPE_CODE_STRUCT:
420 case TYPE_CODE_UNION:
421 case TYPE_CODE_FUNC:
422 case TYPE_CODE_FLT:
423 case TYPE_CODE_VOID:
424 case TYPE_CODE_SET:
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:
430 case TYPE_CODE_REF:
431 warning (_("internal error: unhandled type in ada_print_scalar"));
432 break;
434 default:
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. */
445 static void
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);
451 unsigned int i;
452 unsigned int things_printed = 0;
453 int in_quotes = 0;
454 int need_comma = 0;
456 if (length == 0)
458 fputs_filtered ("\"\"", stream);
459 return;
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. */
466 unsigned int rep1;
467 /* Number of repetitions we have detected so far. */
468 unsigned int reps;
470 QUIT;
472 if (need_comma)
474 fputs_filtered (", ", stream);
475 need_comma = 0;
478 rep1 = i + 1;
479 reps = 1;
480 while (rep1 < length
481 && char_at (string, rep1, type_len, byte_order)
482 == char_at (string, i, type_len, byte_order))
484 rep1 += 1;
485 reps += 1;
488 if (reps > options->repeat_count_threshold)
490 if (in_quotes)
492 fputs_filtered ("\", ", stream);
493 in_quotes = 0;
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);
501 i = rep1 - 1;
502 things_printed += options->repeat_count_threshold;
503 need_comma = 1;
505 else
507 if (!in_quotes)
509 fputs_filtered ("\"", stream);
510 in_quotes = 1;
512 ada_emit_char (char_at (string, i, type_len, byte_order),
513 elttype, stream, '"', type_len);
514 things_printed += 1;
518 /* Terminate the quotes if necessary. */
519 if (in_quotes)
520 fputs_filtered ("\"", stream);
522 if (force_ellipses || i < length)
523 fputs_filtered ("...", stream);
526 void
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),
533 options);
536 static int
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,
541 int comma_needed,
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);
548 if (which < 0)
549 return 0;
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
567 call.
569 Returns 1 if COMMA_NEEDED or any fields were printed. */
571 static int
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,
575 int comma_needed,
576 const struct language_defn *language)
578 int i, len;
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))
586 continue;
588 if (ada_is_wrapper_field (type, i))
590 struct value *field_val = ada_value_primitive_field (value, 0,
591 i, type);
592 comma_needed =
593 print_field_values (field_val, field_val,
594 stream, recurse, options,
595 comma_needed, language);
596 continue;
598 else if (ada_is_variant_part (type, i))
600 comma_needed =
601 print_variant_part (value, i, outer_value, stream, recurse,
602 options, comma_needed, language);
603 continue;
606 if (comma_needed)
607 fprintf_filtered (stream, ", ");
608 comma_needed = 1;
610 if (options->prettyformat)
612 fprintf_filtered (stream, "\n");
613 print_spaces_filtered (2 + 2 * recurse, stream);
615 else
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
631 order problems. */
632 if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
634 fputs_styled (_("<optimized out or zero length>"),
635 metadata_style.style (), stream);
637 else
639 struct value *v;
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
646 (value, nullptr,
647 bit_pos / HOST_CHAR_BIT,
648 bit_pos % HOST_CHAR_BIT,
649 bit_size, type->field (i).type ());
650 opts = *options;
651 opts.deref_ref = 0;
652 common_val_print (v, stream, recurse + 1, &opts, language);
655 else
657 struct value_print_options opts = *options;
659 opts.deref_ref = 0;
661 struct value *v = value_field (value, i);
662 common_val_print (v, stream, recurse + 1, &opts, language);
664 annotate_field_end ();
667 return comma_needed;
670 /* Implement Ada val_print'ing for the case where TYPE is
671 a TYPE_CODE_ARRAY of characters. */
673 static void
674 ada_val_print_string (struct type *type, const gdb_byte *valaddr,
675 int offset_aligned,
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);
681 unsigned int eltlen;
682 unsigned int len;
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)
698 int temp_len;
700 /* Look for a NULL char. */
701 for (temp_len = 0;
702 (temp_len < len
703 && temp_len < options->print_max
704 && char_at (valaddr + offset_aligned,
705 temp_len, eltlen, byte_order) != 0);
706 temp_len += 1);
707 len = temp_len;
710 printstr (stream, elttype, valaddr + offset_aligned, len, 0,
711 eltlen, options);
714 /* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers,
715 thin pointers, etc). */
717 static void
718 ada_val_print_gnat_array (struct value *val,
719 struct ui_file *stream, int recurse,
720 const struct value_print_options *options)
722 scoped_value_mark free_values;
724 struct type *type = ada_check_typedef (value_type (val));
726 /* If this is a reference, coerce it now. This helps taking care
727 of the case where ADDRESS is meaningless because original_value
728 was not an lval. */
729 val = coerce_ref (val);
730 if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */
731 val = ada_coerce_to_simple_array_ptr (val);
732 else
733 val = ada_coerce_to_simple_array (val);
734 if (val == NULL)
736 gdb_assert (type->code () == TYPE_CODE_TYPEDEF);
737 fprintf_filtered (stream, "0x0");
739 else
740 common_val_print (val, stream, recurse, options,
741 language_def (language_ada));
744 /* Implement Ada value_print'ing for the case where TYPE is a
745 TYPE_CODE_PTR. */
747 static void
748 ada_value_print_ptr (struct value *val,
749 struct ui_file *stream, int recurse,
750 const struct value_print_options *options)
752 common_val_print (val, stream, recurse, options, language_def (language_c));
754 struct type *type = ada_check_typedef (value_type (val));
755 if (ada_is_tag_type (type))
757 gdb::unique_xmalloc_ptr<char> name = ada_tag_name (val);
759 if (name != NULL)
760 fprintf_filtered (stream, " (%s)", name.get ());
764 /* Implement Ada val_print'ing for the case where TYPE is
765 a TYPE_CODE_INT or TYPE_CODE_RANGE. */
767 static void
768 ada_value_print_num (struct value *val, struct ui_file *stream, int recurse,
769 const struct value_print_options *options)
771 struct type *type = ada_check_typedef (value_type (val));
772 const gdb_byte *valaddr = value_contents_for_printing (val);
774 if (ada_is_gnat_encoded_fixed_point_type (type))
776 struct value *scale = ada_scaling_factor (type);
777 val = value_cast (value_type (scale), val);
778 val = value_binop (val, scale, BINOP_MUL);
780 const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g";
781 std::string str
782 = target_float_to_string (value_contents (val), value_type (val), fmt);
783 fputs_filtered (str.c_str (), stream);
784 return;
786 else if (type->code () == TYPE_CODE_RANGE
787 && (TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_ENUM
788 || TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_BOOL
789 || TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_CHAR))
791 /* For enum-valued ranges, we want to recurse, because we'll end
792 up printing the constant's name rather than its numeric
793 value. Character and fixed-point types are also printed
794 differently, so recuse for those as well. */
795 struct type *target_type = TYPE_TARGET_TYPE (type);
796 val = value_cast (target_type, val);
797 common_val_print (val, stream, recurse + 1, options,
798 language_def (language_ada));
799 return;
801 else
803 int format = (options->format ? options->format
804 : options->output_format);
806 if (format)
808 struct value_print_options opts = *options;
810 opts.format = format;
811 value_print_scalar_formatted (val, &opts, 0, stream);
813 else if (ada_is_system_address_type (type))
815 /* FIXME: We want to print System.Address variables using
816 the same format as for any access type. But for some
817 reason GNAT encodes the System.Address type as an int,
818 so we have to work-around this deficiency by handling
819 System.Address values as a special case. */
821 struct gdbarch *gdbarch = get_type_arch (type);
822 struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
823 CORE_ADDR addr = extract_typed_address (valaddr, ptr_type);
825 fprintf_filtered (stream, "(");
826 type_print (type, "", stream, -1);
827 fprintf_filtered (stream, ") ");
828 fputs_filtered (paddress (gdbarch, addr), stream);
830 else
832 value_print_scalar_formatted (val, options, 0, stream);
833 if (ada_is_character_type (type))
835 LONGEST c;
837 fputs_filtered (" ", stream);
838 c = unpack_long (type, valaddr);
839 ada_printchar (c, type, stream);
842 return;
846 /* Implement Ada val_print'ing for the case where TYPE is
847 a TYPE_CODE_ENUM. */
849 static void
850 ada_val_print_enum (struct value *value, struct ui_file *stream, int recurse,
851 const struct value_print_options *options)
853 int i;
854 unsigned int len;
855 LONGEST val;
857 if (options->format)
859 value_print_scalar_formatted (value, options, 0, stream);
860 return;
863 struct type *type = ada_check_typedef (value_type (value));
864 const gdb_byte *valaddr = value_contents_for_printing (value);
865 int offset_aligned = ada_aligned_value_addr (type, valaddr) - valaddr;
867 len = type->num_fields ();
868 val = unpack_long (type, valaddr + offset_aligned);
869 for (i = 0; i < len; i++)
871 QUIT;
872 if (val == TYPE_FIELD_ENUMVAL (type, i))
873 break;
876 if (i < len)
878 const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
880 if (name[0] == '\'')
881 fprintf_filtered (stream, "%ld %ps", (long) val,
882 styled_string (variable_name_style.style (),
883 name));
884 else
885 fputs_styled (name, variable_name_style.style (), stream);
887 else
888 print_longest (stream, 'd', 0, val);
891 /* Implement Ada val_print'ing for the case where the type is
892 TYPE_CODE_STRUCT or TYPE_CODE_UNION. */
894 static void
895 ada_val_print_struct_union (struct value *value,
896 struct ui_file *stream,
897 int recurse,
898 const struct value_print_options *options)
900 if (ada_is_bogus_array_descriptor (value_type (value)))
902 fprintf_filtered (stream, "(...?)");
903 return;
906 fprintf_filtered (stream, "(");
908 if (print_field_values (value, value, stream, recurse, options,
909 0, language_def (language_ada)) != 0
910 && options->prettyformat)
912 fprintf_filtered (stream, "\n");
913 print_spaces_filtered (2 * recurse, stream);
916 fprintf_filtered (stream, ")");
919 /* Implement Ada value_print'ing for the case where TYPE is a
920 TYPE_CODE_ARRAY. */
922 static void
923 ada_value_print_array (struct value *val, struct ui_file *stream, int recurse,
924 const struct value_print_options *options)
926 struct type *type = ada_check_typedef (value_type (val));
928 /* For an array of characters, print with string syntax. */
929 if (ada_is_string_type (type)
930 && (options->format == 0 || options->format == 's'))
932 const gdb_byte *valaddr = value_contents_for_printing (val);
933 int offset_aligned = ada_aligned_value_addr (type, valaddr) - valaddr;
935 ada_val_print_string (type, valaddr, offset_aligned, stream, recurse,
936 options);
937 return;
940 fprintf_filtered (stream, "(");
941 print_optional_low_bound (stream, type, options);
942 if (TYPE_FIELD_BITSIZE (type, 0) > 0)
944 const gdb_byte *valaddr = value_contents_for_printing (val);
945 int offset_aligned = ada_aligned_value_addr (type, valaddr) - valaddr;
946 val_print_packed_array_elements (type, valaddr, offset_aligned,
947 stream, recurse, options);
949 else
950 value_print_array_elements (val, stream, recurse, options, 0);
951 fprintf_filtered (stream, ")");
954 /* Implement Ada val_print'ing for the case where TYPE is
955 a TYPE_CODE_REF. */
957 static void
958 ada_val_print_ref (struct type *type, const gdb_byte *valaddr,
959 int offset, int offset_aligned, CORE_ADDR address,
960 struct ui_file *stream, int recurse,
961 struct value *original_value,
962 const struct value_print_options *options)
964 /* For references, the debugger is expected to print the value as
965 an address if DEREF_REF is null. But printing an address in place
966 of the object value would be confusing to an Ada programmer.
967 So, for Ada values, we print the actual dereferenced value
968 regardless. */
969 struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
970 struct value *deref_val;
971 CORE_ADDR deref_val_int;
973 if (elttype->code () == TYPE_CODE_UNDEF)
975 fputs_styled ("<ref to undefined type>", metadata_style.style (),
976 stream);
977 return;
980 deref_val = coerce_ref_if_computed (original_value);
981 if (deref_val)
983 if (ada_is_tagged_type (value_type (deref_val), 1))
984 deref_val = ada_tag_value_at_base_address (deref_val);
986 common_val_print (deref_val, stream, recurse + 1, options,
987 language_def (language_ada));
988 return;
991 deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
992 if (deref_val_int == 0)
994 fputs_filtered ("(null)", stream);
995 return;
998 deref_val
999 = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype),
1000 deref_val_int));
1001 if (ada_is_tagged_type (value_type (deref_val), 1))
1002 deref_val = ada_tag_value_at_base_address (deref_val);
1004 /* Make sure that the object does not have an unreasonable size
1005 before trying to print it. This can happen for instance with
1006 references to dynamic objects whose contents is uninitialized
1007 (Eg: an array whose bounds are not set yet). */
1008 ada_ensure_varsize_limit (value_type (deref_val));
1010 if (value_lazy (deref_val))
1011 value_fetch_lazy (deref_val);
1013 common_val_print (deref_val, stream, recurse + 1,
1014 options, language_def (language_ada));
1017 /* See the comment on ada_value_print. This function differs in that
1018 it does not catch evaluation errors (leaving that to
1019 ada_value_print). */
1021 static void
1022 ada_value_print_1 (struct value *val, struct ui_file *stream, int recurse,
1023 const struct value_print_options *options)
1025 struct type *type = ada_check_typedef (value_type (val));
1027 if (ada_is_array_descriptor_type (type)
1028 || (ada_is_constrained_packed_array_type (type)
1029 && type->code () != TYPE_CODE_PTR))
1031 ada_val_print_gnat_array (val, stream, recurse, options);
1032 return;
1035 val = ada_to_fixed_value (val);
1036 type = value_type (val);
1037 struct type *saved_type = type;
1039 const gdb_byte *valaddr = value_contents_for_printing (val);
1040 CORE_ADDR address = value_address (val);
1041 gdb::array_view<const gdb_byte> view
1042 = gdb::make_array_view (valaddr, TYPE_LENGTH (type));
1043 type = ada_check_typedef (resolve_dynamic_type (type, view, address));
1044 if (type != saved_type)
1046 val = value_copy (val);
1047 deprecated_set_value_type (val, type);
1050 switch (type->code ())
1052 default:
1053 common_val_print (val, stream, recurse, options,
1054 language_def (language_c));
1055 break;
1057 case TYPE_CODE_PTR:
1058 ada_value_print_ptr (val, stream, recurse, options);
1059 break;
1061 case TYPE_CODE_INT:
1062 case TYPE_CODE_RANGE:
1063 ada_value_print_num (val, stream, recurse, options);
1064 break;
1066 case TYPE_CODE_ENUM:
1067 ada_val_print_enum (val, stream, recurse, options);
1068 break;
1070 case TYPE_CODE_FLT:
1071 if (options->format)
1073 common_val_print (val, stream, recurse, options,
1074 language_def (language_c));
1075 break;
1078 ada_print_floating (valaddr, type, stream);
1079 break;
1081 case TYPE_CODE_UNION:
1082 case TYPE_CODE_STRUCT:
1083 ada_val_print_struct_union (val, stream, recurse, options);
1084 break;
1086 case TYPE_CODE_ARRAY:
1087 ada_value_print_array (val, stream, recurse, options);
1088 return;
1090 case TYPE_CODE_REF:
1091 ada_val_print_ref (type, valaddr, 0, 0,
1092 address, stream, recurse, val,
1093 options);
1094 break;
1098 /* See ada-lang.h. */
1100 void
1101 ada_value_print_inner (struct value *val, struct ui_file *stream,
1102 int recurse,
1103 const struct value_print_options *options)
1107 ada_value_print_1 (val, stream, recurse, options);
1109 catch (const gdb_exception_error &except)
1111 fprintf_styled (stream, metadata_style.style (),
1112 _("<error reading variable: %s>"),
1113 except.what ());
1117 void
1118 ada_value_print (struct value *val0, struct ui_file *stream,
1119 const struct value_print_options *options)
1121 struct value *val = ada_to_fixed_value (val0);
1122 struct type *type = ada_check_typedef (value_type (val));
1123 struct value_print_options opts;
1125 /* If it is a pointer, indicate what it points to. */
1126 if (type->code () == TYPE_CODE_PTR)
1128 /* Hack: don't print (char *) for char strings. Their
1129 type is indicated by the quoted string anyway. */
1130 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
1131 || TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_INT
1132 || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
1134 fprintf_filtered (stream, "(");
1135 type_print (type, "", stream, -1);
1136 fprintf_filtered (stream, ") ");
1139 else if (ada_is_array_descriptor_type (type))
1141 /* We do not print the type description unless TYPE is an array
1142 access type (this is encoded by the compiler as a typedef to
1143 a fat pointer - hence the check against TYPE_CODE_TYPEDEF). */
1144 if (type->code () == TYPE_CODE_TYPEDEF)
1146 fprintf_filtered (stream, "(");
1147 type_print (type, "", stream, -1);
1148 fprintf_filtered (stream, ") ");
1151 else if (ada_is_bogus_array_descriptor (type))
1153 fprintf_filtered (stream, "(");
1154 type_print (type, "", stream, -1);
1155 fprintf_filtered (stream, ") (...?)");
1156 return;
1159 opts = *options;
1160 opts.deref_ref = 1;
1161 common_val_print (val, stream, 0, &opts, current_language);