]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/ada-valprint.c
Add support for printing value of DWARF-based fixed-point type objects
[thirdparty/binutils-gdb.git] / gdb / ada-valprint.c
CommitLineData
4c4b4cd2 1/* Support for printing Ada values for GDB, the GNU debugger.
d56612af 2
b811d2c2 3 Copyright (C) 1986-2020 Free Software Foundation, Inc.
14f9c5c9 4
a9762ec7 5 This file is part of GDB.
14f9c5c9 6
a9762ec7
JB
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.
14f9c5c9 11
a9762ec7
JB
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.
14f9c5c9 16
a9762ec7
JB
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/>. */
14f9c5c9 19
14f9c5c9 20#include "defs.h"
12c89474 21#include <ctype.h>
4de283e4
TT
22#include "gdbtypes.h"
23#include "expression.h"
24#include "value.h"
4de283e4
TT
25#include "valprint.h"
26#include "language.h"
d55e5aa6 27#include "annotate.h"
4de283e4 28#include "ada-lang.h"
50eff16b 29#include "target-float.h"
7f6aba03 30#include "cli/cli-style.h"
cdc46a9f 31#include "gdbarch.h"
14f9c5c9 32
70304be9 33static int print_field_values (struct value *, struct value *,
79a45b7d
TT
34 struct ui_file *, int,
35 const struct value_print_options *,
70304be9
TT
36 int, const struct language_defn *);
37
14f9c5c9
AS
38\f
39
4c4b4cd2 40/* Make TYPE unsigned if its range of values includes no negatives. */
d2e4a39e 41static void
4dc81987 42adjust_type_signedness (struct type *type)
14f9c5c9 43{
78134374 44 if (type != NULL && type->code () == TYPE_CODE_RANGE
5537ddd0 45 && type->bounds ()->low.const_val () >= 0)
653223d3 46 type->set_is_unsigned (true);
d2e4a39e 47}
14f9c5c9 48
e936309c
JB
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. */
14f9c5c9 53
d2e4a39e 54static int
79a45b7d
TT
55print_optional_low_bound (struct ui_file *stream, struct type *type,
56 const struct value_print_options *options)
14f9c5c9
AS
57{
58 struct type *index_type;
df178451
PM
59 LONGEST low_bound;
60 LONGEST high_bound;
14f9c5c9 61
79a45b7d 62 if (options->print_array_indexes)
14f9c5c9 63 return 0;
e79af960 64
e936309c
JB
65 if (!get_array_bounds (type, &low_bound, &high_bound))
66 return 0;
67
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)
14f9c5c9 72 return 0;
d2e4a39e 73
3d967001 74 index_type = type->index_type ();
e79af960 75
78134374 76 while (index_type->code () == TYPE_CODE_RANGE)
fd1b946e
JB
77 {
78 /* We need to know what the base type is, in order to do the
dda83cd7
SM
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. */
fd1b946e
JB
83 index_type = TYPE_TARGET_TYPE (index_type);
84 }
85
e3861a03 86 /* Don't print the lower bound if it's the default one. */
78134374 87 switch (index_type->code ())
d2e4a39e 88 {
690cc4eb 89 case TYPE_CODE_BOOL:
e3861a03 90 case TYPE_CODE_CHAR:
690cc4eb
PH
91 if (low_bound == 0)
92 return 0;
93 break;
d2e4a39e 94 case TYPE_CODE_ENUM:
53a47a3e 95 if (low_bound == 0)
d2e4a39e 96 return 0;
53a47a3e 97 low_bound = TYPE_FIELD_ENUMVAL (index_type, low_bound);
d2e4a39e
AS
98 break;
99 case TYPE_CODE_UNDEF:
7c964f07 100 index_type = NULL;
d2e4a39e
AS
101 /* FALL THROUGH */
102 default:
103 if (low_bound == 1)
104 return 0;
105 break;
106 }
14f9c5c9 107
df178451 108 ada_print_scalar (index_type, low_bound, stream);
14f9c5c9
AS
109 fprintf_filtered (stream, " => ");
110 return 1;
111}
112
113/* Version of val_print_array_elements for GNAT-style packed arrays.
b59eac37
TT
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). */
14f9c5c9
AS
118
119static void
fc1a4b47 120val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
b59eac37 121 int offset, struct ui_file *stream,
79a45b7d
TT
122 int recurse,
123 const struct value_print_options *options)
14f9c5c9
AS
124{
125 unsigned int i;
126 unsigned int things_printed = 0;
127 unsigned len;
e79af960 128 struct type *elttype, *index_type;
14f9c5c9 129 unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
d2e4a39e 130 struct value *mark = value_mark ();
e79af960 131 LONGEST low = 0;
d2e4a39e 132
14f9c5c9 133 elttype = TYPE_TARGET_TYPE (type);
3d967001 134 index_type = type->index_type ();
14f9c5c9
AS
135
136 {
e79af960 137 LONGEST high;
5b4ee69b 138
262452ec 139 if (get_discrete_bounds (index_type, &low, &high) < 0)
14f9c5c9 140 len = 1;
53a47a3e 141 else if (low > high)
04bafb1e 142 {
dda83cd7
SM
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! */
53a47a3e 147 len = 0;
04bafb1e 148 }
53a47a3e
TT
149 else
150 len = high - low + 1;
14f9c5c9
AS
151 }
152
53a47a3e
TT
153 if (index_type->code () == TYPE_CODE_RANGE)
154 index_type = TYPE_TARGET_TYPE (index_type);
155
14f9c5c9
AS
156 i = 0;
157 annotate_array_section_begin (i, elttype);
158
79a45b7d 159 while (i < len && things_printed < options->print_max)
14f9c5c9
AS
160 {
161 struct value *v0, *v1;
162 int i0;
163
164 if (i != 0)
165 {
2a998fc0 166 if (options->prettyformat_arrays)
14f9c5c9
AS
167 {
168 fprintf_filtered (stream, ",\n");
169 print_spaces_filtered (2 + 2 * recurse, stream);
170 }
171 else
172 {
173 fprintf_filtered (stream, ", ");
174 }
175 }
d642b692
HD
176 else if (options->prettyformat_arrays)
177 {
178 fprintf_filtered (stream, "\n");
179 print_spaces_filtered (2 + 2 * recurse, stream);
180 }
14f9c5c9 181 wrap_here (n_spaces (2 + 2 * recurse));
79a45b7d 182 maybe_print_array_index (index_type, i + low, stream, options);
14f9c5c9
AS
183
184 i0 = i;
490f124f 185 v0 = ada_value_primitive_packed_val (NULL, valaddr + offset,
14f9c5c9
AS
186 (i0 * bitsize) / HOST_CHAR_BIT,
187 (i0 * bitsize) % HOST_CHAR_BIT,
188 bitsize, elttype);
189 while (1)
190 {
191 i += 1;
192 if (i >= len)
193 break;
490f124f 194 v1 = ada_value_primitive_packed_val (NULL, valaddr + offset,
14f9c5c9
AS
195 (i * bitsize) / HOST_CHAR_BIT,
196 (i * bitsize) % HOST_CHAR_BIT,
197 bitsize, elttype);
2478d075
JB
198 if (TYPE_LENGTH (check_typedef (value_type (v0)))
199 != TYPE_LENGTH (check_typedef (value_type (v1))))
200 break;
9a0dc9e3
PA
201 if (!value_contents_eq (v0, value_embedded_offset (v0),
202 v1, value_embedded_offset (v1),
2478d075 203 TYPE_LENGTH (check_typedef (value_type (v0)))))
14f9c5c9
AS
204 break;
205 }
206
79a45b7d 207 if (i - i0 > options->repeat_count_threshold)
14f9c5c9 208 {
79a45b7d 209 struct value_print_options opts = *options;
5b4ee69b 210
79a45b7d 211 opts.deref_ref = 0;
b59eac37 212 common_val_print (v0, stream, recurse + 1, &opts, current_language);
14f9c5c9 213 annotate_elt_rep (i - i0);
7f6aba03
TT
214 fprintf_filtered (stream, _(" %p[<repeats %u times>%p]"),
215 metadata_style.style ().ptr (), i - i0, nullptr);
14f9c5c9
AS
216 annotate_elt_rep_end ();
217
218 }
219 else
220 {
221 int j;
79a45b7d 222 struct value_print_options opts = *options;
5b4ee69b 223
79a45b7d 224 opts.deref_ref = 0;
14f9c5c9
AS
225 for (j = i0; j < i; j += 1)
226 {
d2e4a39e 227 if (j > i0)
14f9c5c9 228 {
2a998fc0 229 if (options->prettyformat_arrays)
14f9c5c9
AS
230 {
231 fprintf_filtered (stream, ",\n");
232 print_spaces_filtered (2 + 2 * recurse, stream);
233 }
234 else
235 {
236 fprintf_filtered (stream, ", ");
237 }
238 wrap_here (n_spaces (2 + 2 * recurse));
e79af960 239 maybe_print_array_index (index_type, j + low,
79a45b7d 240 stream, options);
14f9c5c9 241 }
b59eac37
TT
242 common_val_print (v0, stream, recurse + 1, &opts,
243 current_language);
14f9c5c9
AS
244 annotate_elt ();
245 }
246 }
247 things_printed += i - i0;
248 }
249 annotate_array_section_end ();
250 if (i < len)
251 {
252 fprintf_filtered (stream, "...");
253 }
254
255 value_free_to_mark (mark);
256}
257
14f9c5c9
AS
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
4ffa5a33 260 of the character. */
14f9c5c9
AS
261
262void
6c7a06a3
TT
263ada_emit_char (int c, struct type *type, struct ui_file *stream,
264 int quoter, int type_len)
14f9c5c9 265{
4ffa5a33
JB
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))
14f9c5c9
AS
273 {
274 if (c == quoter && c == '"')
529cad9c 275 fprintf_filtered (stream, "\"\"");
14f9c5c9
AS
276 else
277 fprintf_filtered (stream, "%c", c);
278 }
279 else
d2e4a39e 280 fprintf_filtered (stream, "[\"%0*x\"]", type_len * 2, c);
14f9c5c9
AS
281}
282
4ffa5a33
JB
283/* Character #I of STRING, given that TYPE_LEN is the size in bytes
284 of a character. */
14f9c5c9
AS
285
286static int
e17a4113
UW
287char_at (const gdb_byte *string, int i, int type_len,
288 enum bfd_endian byte_order)
14f9c5c9
AS
289{
290 if (type_len == 1)
291 return string[i];
d2e4a39e 292 else
4ffa5a33 293 return (int) extract_unsigned_integer (string + type_len * i,
dda83cd7 294 type_len, byte_order);
14f9c5c9
AS
295}
296
4c4b4cd2
PH
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
4fbf5aa5
JB
300 point. We use the GNAT format for NaNs and infinities. */
301
4c4b4cd2 302static void
fc1a4b47 303ada_print_floating (const gdb_byte *valaddr, struct type *type,
a2bd3dcd 304 struct ui_file *stream)
4c4b4cd2 305{
d7e74731 306 string_file tmp_stream;
4c4b4cd2 307
d7e74731 308 print_floating (valaddr, type, &tmp_stream);
77e1c742 309
d7e74731 310 std::string &s = tmp_stream.string ();
77e1c742 311 size_t skip_count = 0;
4c4b4cd2
PH
312
313 /* Modify for Ada rules. */
606b8d1a 314
77e1c742
PA
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");
c3e5cd34 322
77e1c742 323 if (pos == std::string::npos)
4c4b4cd2 324 {
77e1c742
PA
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)
c3e5cd34 331 {
77e1c742
PA
332 s[pos] = s[pos + 2] = 'N';
333 if (s[0] == '-')
334 skip_count = 1;
c3e5cd34 335 }
4c4b4cd2 336 }
c3e5cd34 337
77e1c742
PA
338 if (pos == std::string::npos
339 && s.find ('.') == std::string::npos)
4c4b4cd2 340 {
77e1c742
PA
341 pos = s.find ('e');
342 if (pos == std::string::npos)
343 fprintf_filtered (stream, "%s.0", s.c_str ());
4c4b4cd2 344 else
77e1c742 345 fprintf_filtered (stream, "%.*s.0%s", (int) pos, s.c_str (), &s[pos]);
4c4b4cd2 346 }
4fbf5aa5 347 else
77e1c742 348 fprintf_filtered (stream, "%s", &s[skip_count]);
4c4b4cd2
PH
349}
350
14f9c5c9 351void
6c7a06a3 352ada_printchar (int c, struct type *type, struct ui_file *stream)
14f9c5c9
AS
353{
354 fputs_filtered ("'", stream);
447b483c 355 ada_emit_char (c, type, stream, '\'', TYPE_LENGTH (type));
14f9c5c9
AS
356 fputs_filtered ("'", stream);
357}
358
359/* [From print_type_scalar in typeprint.c]. Print VAL on STREAM in a
7c964f07
UW
360 form appropriate for TYPE, if non-NULL. If TYPE is NULL, print VAL
361 like a default signed integer. */
14f9c5c9
AS
362
363void
ebf56fd3 364ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
14f9c5c9
AS
365{
366 unsigned int i;
367 unsigned len;
368
7c964f07
UW
369 if (!type)
370 {
371 print_longest (stream, 'd', 0, val);
372 return;
373 }
374
61ee279c 375 type = ada_check_typedef (type);
14f9c5c9 376
78134374 377 switch (type->code ())
14f9c5c9
AS
378 {
379
380 case TYPE_CODE_ENUM:
1f704f76 381 len = type->num_fields ();
14f9c5c9
AS
382 for (i = 0; i < len; i++)
383 {
14e75d8e 384 if (TYPE_FIELD_ENUMVAL (type, i) == val)
14f9c5c9
AS
385 {
386 break;
387 }
388 }
389 if (i < len)
390 {
3f0cbb04
TT
391 fputs_styled (ada_enum_name (TYPE_FIELD_NAME (type, i)),
392 variable_name_style.style (), stream);
14f9c5c9
AS
393 }
394 else
395 {
396 print_longest (stream, 'd', 0, val);
397 }
398 break;
399
400 case TYPE_CODE_INT:
c6d940a9 401 print_longest (stream, type->is_unsigned () ? 'u' : 'd', 0, val);
14f9c5c9
AS
402 break;
403
404 case TYPE_CODE_CHAR:
10d44370 405 LA_PRINT_CHAR (val, type, stream);
14f9c5c9
AS
406 break;
407
408 case TYPE_CODE_BOOL:
409 fprintf_filtered (stream, val ? "true" : "false");
410 break;
411
412 case TYPE_CODE_RANGE:
413 ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
414 return;
415
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:
0d5de010
DJ
427 case TYPE_CODE_MEMBERPTR:
428 case TYPE_CODE_METHODPTR:
14f9c5c9
AS
429 case TYPE_CODE_METHOD:
430 case TYPE_CODE_REF:
edefbb7c 431 warning (_("internal error: unhandled type in ada_print_scalar"));
14f9c5c9
AS
432 break;
433
434 default:
edefbb7c 435 error (_("Invalid type code in symbol table."));
14f9c5c9 436 }
14f9c5c9
AS
437}
438
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
9a153e0b
JB
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. */
14f9c5c9
AS
444
445static void
6c7a06a3 446printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
79a45b7d
TT
447 unsigned int length, int force_ellipses, int type_len,
448 const struct value_print_options *options)
14f9c5c9 449{
34877895 450 enum bfd_endian byte_order = type_byte_order (elttype);
14f9c5c9
AS
451 unsigned int i;
452 unsigned int things_printed = 0;
453 int in_quotes = 0;
454 int need_comma = 0;
455
456 if (length == 0)
457 {
458 fputs_filtered ("\"\"", stream);
459 return;
460 }
461
79a45b7d 462 for (i = 0; i < length && things_printed < options->print_max; i += 1)
14f9c5c9
AS
463 {
464 /* Position of the character we are examining
dda83cd7 465 to see whether it is repeated. */
14f9c5c9
AS
466 unsigned int rep1;
467 /* Number of repetitions we have detected so far. */
468 unsigned int reps;
469
470 QUIT;
471
472 if (need_comma)
473 {
474 fputs_filtered (", ", stream);
475 need_comma = 0;
476 }
477
478 rep1 = i + 1;
479 reps = 1;
c3e5cd34 480 while (rep1 < length
e17a4113
UW
481 && char_at (string, rep1, type_len, byte_order)
482 == char_at (string, i, type_len, byte_order))
14f9c5c9
AS
483 {
484 rep1 += 1;
485 reps += 1;
486 }
487
79a45b7d 488 if (reps > options->repeat_count_threshold)
14f9c5c9
AS
489 {
490 if (in_quotes)
491 {
e93a8774 492 fputs_filtered ("\", ", stream);
14f9c5c9
AS
493 in_quotes = 0;
494 }
495 fputs_filtered ("'", stream);
e17a4113
UW
496 ada_emit_char (char_at (string, i, type_len, byte_order),
497 elttype, stream, '\'', type_len);
14f9c5c9 498 fputs_filtered ("'", stream);
7f6aba03
TT
499 fprintf_filtered (stream, _(" %p[<repeats %u times>%p]"),
500 metadata_style.style ().ptr (), reps, nullptr);
14f9c5c9 501 i = rep1 - 1;
79a45b7d 502 things_printed += options->repeat_count_threshold;
14f9c5c9
AS
503 need_comma = 1;
504 }
505 else
506 {
507 if (!in_quotes)
508 {
e93a8774 509 fputs_filtered ("\"", stream);
14f9c5c9
AS
510 in_quotes = 1;
511 }
e17a4113
UW
512 ada_emit_char (char_at (string, i, type_len, byte_order),
513 elttype, stream, '"', type_len);
14f9c5c9
AS
514 things_printed += 1;
515 }
516 }
517
518 /* Terminate the quotes if necessary. */
519 if (in_quotes)
e93a8774 520 fputs_filtered ("\"", stream);
14f9c5c9
AS
521
522 if (force_ellipses || i < length)
523 fputs_filtered ("...", stream);
524}
525
526void
0963b4bd
MS
527ada_printstr (struct ui_file *stream, struct type *type,
528 const gdb_byte *string, unsigned int length,
529 const char *encoding, int force_ellipses,
79a45b7d 530 const struct value_print_options *options)
14f9c5c9 531{
6c7a06a3
TT
532 printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
533 options);
14f9c5c9
AS
534}
535
bdf779a0 536static int
70304be9
TT
537print_variant_part (struct value *value, int field_num,
538 struct value *outer_value,
bdf779a0 539 struct ui_file *stream, int recurse,
bdf779a0
JB
540 const struct value_print_options *options,
541 int comma_needed,
8e355c5d 542 const struct language_defn *language)
bdf779a0 543{
70304be9 544 struct type *type = value_type (value);
940da03e 545 struct type *var_type = type->field (field_num).type ();
d8af9068 546 int which = ada_which_variant_applies (var_type, outer_value);
bdf779a0
JB
547
548 if (which < 0)
549 return 0;
70304be9 550
6ee448cc
TT
551 struct value *variant_field = value_field (value, field_num);
552 struct value *active_component = value_field (variant_field, which);
70304be9
TT
553 return print_field_values (active_component, outer_value, stream, recurse,
554 options, comma_needed, language);
bdf779a0
JB
555}
556
70304be9 557/* Print out fields of VALUE.
bdf779a0 558
70304be9
TT
559 STREAM, RECURSE, and OPTIONS have the same meanings as in
560 ada_print_value and ada_value_print.
bdf779a0 561
70304be9
TT
562 OUTER_VALUE gives the enclosing record (used to get discriminant
563 values when printing variant parts).
bdf779a0
JB
564
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.
568
569 Returns 1 if COMMA_NEEDED or any fields were printed. */
570
571static int
70304be9
TT
572print_field_values (struct value *value, struct value *outer_value,
573 struct ui_file *stream, int recurse,
bdf779a0
JB
574 const struct value_print_options *options,
575 int comma_needed,
8e355c5d 576 const struct language_defn *language)
bdf779a0
JB
577{
578 int i, len;
579
70304be9 580 struct type *type = value_type (value);
1f704f76 581 len = type->num_fields ();
bdf779a0
JB
582
583 for (i = 0; i < len; i += 1)
584 {
585 if (ada_is_ignored_field (type, i))
586 continue;
587
588 if (ada_is_wrapper_field (type, i))
589 {
5eb68a39
TT
590 struct value *field_val = ada_value_primitive_field (value, 0,
591 i, type);
bdf779a0 592 comma_needed =
6ee448cc 593 print_field_values (field_val, field_val,
70304be9
TT
594 stream, recurse, options,
595 comma_needed, language);
bdf779a0
JB
596 continue;
597 }
598 else if (ada_is_variant_part (type, i))
599 {
600 comma_needed =
70304be9
TT
601 print_variant_part (value, i, outer_value, stream, recurse,
602 options, comma_needed, language);
bdf779a0
JB
603 continue;
604 }
605
606 if (comma_needed)
607 fprintf_filtered (stream, ", ");
608 comma_needed = 1;
609
610 if (options->prettyformat)
611 {
612 fprintf_filtered (stream, "\n");
613 print_spaces_filtered (2 + 2 * recurse, stream);
614 }
615 else
616 {
617 wrap_here (n_spaces (2 + 2 * recurse));
618 }
619
940da03e 620 annotate_field_begin (type->field (i).type ());
bdf779a0
JB
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 ();
627
628 if (TYPE_FIELD_PACKED (type, i))
629 {
bdf779a0
JB
630 /* Bitfields require special handling, especially due to byte
631 order problems. */
632 if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
633 {
7f6aba03
TT
634 fputs_styled (_("<optimized out or zero length>"),
635 metadata_style.style (), stream);
bdf779a0
JB
636 }
637 else
638 {
e8b24d9f 639 struct value *v;
bdf779a0
JB
640 int bit_pos = TYPE_FIELD_BITPOS (type, i);
641 int bit_size = TYPE_FIELD_BITSIZE (type, i);
642 struct value_print_options opts;
643
940da03e 644 adjust_type_signedness (type->field (i).type ());
bdf779a0 645 v = ada_value_primitive_packed_val
70304be9
TT
646 (value, nullptr,
647 bit_pos / HOST_CHAR_BIT,
bdf779a0 648 bit_pos % HOST_CHAR_BIT,
940da03e 649 bit_size, type->field (i).type ());
bdf779a0
JB
650 opts = *options;
651 opts.deref_ref = 0;
3a916a97 652 common_val_print (v, stream, recurse + 1, &opts, language);
bdf779a0
JB
653 }
654 }
655 else
656 {
657 struct value_print_options opts = *options;
658
659 opts.deref_ref = 0;
3a916a97 660
70304be9 661 struct value *v = value_field (value, i);
3a916a97 662 common_val_print (v, stream, recurse + 1, &opts, language);
bdf779a0
JB
663 }
664 annotate_field_end ();
665 }
666
667 return comma_needed;
668}
669
71855601
JB
670/* Implement Ada val_print'ing for the case where TYPE is
671 a TYPE_CODE_ARRAY of characters. */
672
673static void
674ada_val_print_string (struct type *type, const gdb_byte *valaddr,
b59eac37 675 int offset_aligned,
71855601 676 struct ui_file *stream, int recurse,
71855601
JB
677 const struct value_print_options *options)
678{
34877895 679 enum bfd_endian byte_order = type_byte_order (type);
71855601
JB
680 struct type *elttype = TYPE_TARGET_TYPE (type);
681 unsigned int eltlen;
682 unsigned int len;
683
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);
690
691 eltlen = TYPE_LENGTH (elttype);
692 len = TYPE_LENGTH (type) / eltlen;
693
71855601
JB
694 /* If requested, look for the first null char and only print
695 elements up to it. */
696 if (options->stop_print_at_null)
697 {
698 int temp_len;
699
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;
708 }
709
710 printstr (stream, elttype, valaddr + offset_aligned, len, 0,
711 eltlen, options);
712}
713
416595d6
TT
714/* Implement Ada value_print'ing for the case where TYPE is a
715 TYPE_CODE_PTR. */
716
717static void
718ada_value_print_ptr (struct value *val,
719 struct ui_file *stream, int recurse,
720 const struct value_print_options *options)
721{
722 common_val_print (val, stream, recurse, options, language_def (language_c));
723
724 struct type *type = ada_check_typedef (value_type (val));
725 if (ada_is_tag_type (type))
726 {
f5272a3b 727 gdb::unique_xmalloc_ptr<char> name = ada_tag_name (val);
416595d6
TT
728
729 if (name != NULL)
f5272a3b 730 fprintf_filtered (stream, " (%s)", name.get ());
416595d6
TT
731 }
732}
733
39ef85a8
TT
734/* Implement Ada val_print'ing for the case where TYPE is
735 a TYPE_CODE_INT or TYPE_CODE_RANGE. */
736
737static void
738ada_value_print_num (struct value *val, struct ui_file *stream, int recurse,
739 const struct value_print_options *options)
740{
741 struct type *type = ada_check_typedef (value_type (val));
742 const gdb_byte *valaddr = value_contents_for_printing (val);
743
b2188a06 744 if (ada_is_gnat_encoded_fixed_point_type (type))
39ef85a8 745 {
75f24e86 746 struct value *scale = gnat_encoded_fixed_point_scaling_factor (type);
39ef85a8
TT
747 val = value_cast (value_type (scale), val);
748 val = value_binop (val, scale, BINOP_MUL);
749
750 const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g";
751 std::string str
752 = target_float_to_string (value_contents (val), value_type (val), fmt);
753 fputs_filtered (str.c_str (), stream);
754 return;
755 }
78134374
SM
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))
39ef85a8
TT
760 {
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));
769 return;
770 }
771 else
772 {
773 int format = (options->format ? options->format
774 : options->output_format);
775
776 if (format)
777 {
778 struct value_print_options opts = *options;
779
780 opts.format = format;
781 value_print_scalar_formatted (val, &opts, 0, stream);
782 }
783 else if (ada_is_system_address_type (type))
784 {
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. */
790
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);
794
795 fprintf_filtered (stream, "(");
796 type_print (type, "", stream, -1);
797 fprintf_filtered (stream, ") ");
798 fputs_filtered (paddress (gdbarch, addr), stream);
799 }
800 else
801 {
802 value_print_scalar_formatted (val, options, 0, stream);
803 if (ada_is_character_type (type))
804 {
805 LONGEST c;
806
807 fputs_filtered (" ", stream);
808 c = unpack_long (type, valaddr);
809 ada_printchar (c, type, stream);
810 }
811 }
812 return;
813 }
814}
815
8004dfd1
JB
816/* Implement Ada val_print'ing for the case where TYPE is
817 a TYPE_CODE_ENUM. */
818
819static void
426a9c18 820ada_val_print_enum (struct value *value, struct ui_file *stream, int recurse,
2228ef77 821 const struct value_print_options *options)
8004dfd1
JB
822{
823 int i;
824 unsigned int len;
825 LONGEST val;
826
827 if (options->format)
828 {
426a9c18 829 value_print_scalar_formatted (value, options, 0, stream);
8004dfd1
JB
830 return;
831 }
832
426a9c18
TT
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;
836
1f704f76 837 len = type->num_fields ();
8004dfd1
JB
838 val = unpack_long (type, valaddr + offset_aligned);
839 for (i = 0; i < len; i++)
840 {
841 QUIT;
842 if (val == TYPE_FIELD_ENUMVAL (type, i))
843 break;
844 }
845
846 if (i < len)
847 {
848 const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
849
850 if (name[0] == '\'')
3f0cbb04
TT
851 fprintf_filtered (stream, "%ld %ps", (long) val,
852 styled_string (variable_name_style.style (),
853 name));
8004dfd1 854 else
3f0cbb04 855 fputs_styled (name, variable_name_style.style (), stream);
8004dfd1
JB
856 }
857 else
858 print_longest (stream, 'd', 0, val);
859}
860
70304be9
TT
861/* Implement Ada val_print'ing for the case where the type is
862 TYPE_CODE_STRUCT or TYPE_CODE_UNION. */
8004dfd1
JB
863
864static void
70304be9
TT
865ada_val_print_struct_union (struct value *value,
866 struct ui_file *stream,
867 int recurse,
868 const struct value_print_options *options)
8004dfd1 869{
70304be9 870 if (ada_is_bogus_array_descriptor (value_type (value)))
8004dfd1
JB
871 {
872 fprintf_filtered (stream, "(...?)");
873 return;
874 }
875
079e4591
JB
876 fprintf_filtered (stream, "(");
877
70304be9
TT
878 if (print_field_values (value, value, stream, recurse, options,
879 0, language_def (language_ada)) != 0
079e4591
JB
880 && options->prettyformat)
881 {
882 fprintf_filtered (stream, "\n");
883 print_spaces_filtered (2 * recurse, stream);
884 }
885
886 fprintf_filtered (stream, ")");
8004dfd1
JB
887}
888
b59eac37
TT
889/* Implement Ada value_print'ing for the case where TYPE is a
890 TYPE_CODE_ARRAY. */
891
892static void
893ada_value_print_array (struct value *val, struct ui_file *stream, int recurse,
894 const struct value_print_options *options)
895{
896 struct type *type = ada_check_typedef (value_type (val));
897
898 /* For an array of characters, print with string syntax. */
899 if (ada_is_string_type (type)
900 && (options->format == 0 || options->format == 's'))
901 {
902 const gdb_byte *valaddr = value_contents_for_printing (val);
903 int offset_aligned = ada_aligned_value_addr (type, valaddr) - valaddr;
904
905 ada_val_print_string (type, valaddr, offset_aligned, stream, recurse,
906 options);
907 return;
908 }
909
910 fprintf_filtered (stream, "(");
911 print_optional_low_bound (stream, type, options);
912 if (TYPE_FIELD_BITSIZE (type, 0) > 0)
913 {
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);
918 }
919 else
920 value_print_array_elements (val, stream, recurse, options, 0);
921 fprintf_filtered (stream, ")");
922}
923
8004dfd1
JB
924/* Implement Ada val_print'ing for the case where TYPE is
925 a TYPE_CODE_REF. */
926
927static void
928ada_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,
e8b24d9f 931 struct value *original_value,
2228ef77 932 const struct value_print_options *options)
8004dfd1
JB
933{
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
938 regardless. */
939 struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
34b27950
JB
940 struct value *deref_val;
941 CORE_ADDR deref_val_int;
8004dfd1 942
78134374 943 if (elttype->code () == TYPE_CODE_UNDEF)
8004dfd1 944 {
7f6aba03
TT
945 fputs_styled ("<ref to undefined type>", metadata_style.style (),
946 stream);
34b27950
JB
947 return;
948 }
8004dfd1 949
34b27950
JB
950 deref_val = coerce_ref_if_computed (original_value);
951 if (deref_val)
952 {
953 if (ada_is_tagged_type (value_type (deref_val), 1))
954 deref_val = ada_tag_value_at_base_address (deref_val);
8004dfd1 955
34b27950 956 common_val_print (deref_val, stream, recurse + 1, options,
2228ef77 957 language_def (language_ada));
34b27950
JB
958 return;
959 }
8004dfd1 960
34b27950
JB
961 deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
962 if (deref_val_int == 0)
963 {
964 fputs_filtered ("(null)", stream);
965 return;
8004dfd1 966 }
34b27950
JB
967
968 deref_val
969 = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype),
970 deref_val_int));
971 if (ada_is_tagged_type (value_type (deref_val), 1))
972 deref_val = ada_tag_value_at_base_address (deref_val);
973
c1b5a1a6
JB
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));
979
7d45f3df
YQ
980 if (value_lazy (deref_val))
981 value_fetch_lazy (deref_val);
982
2e088f8b
TT
983 common_val_print (deref_val, stream, recurse + 1,
984 options, language_def (language_ada));
8004dfd1
JB
985}
986
5b5e15ec
TT
987/* See the comment on ada_value_print. This function differs in that
988 it does not catch evaluation errors (leaving that to
989 ada_value_print). */
990
991static void
992ada_value_print_1 (struct value *val, struct ui_file *stream, int recurse,
993 const struct value_print_options *options)
994{
995 struct type *type = ada_check_typedef (value_type (val));
996
997 if (ada_is_array_descriptor_type (type)
998 || (ada_is_constrained_packed_array_type (type)
78134374 999 && type->code () != TYPE_CODE_PTR))
5b5e15ec 1000 {
57567375
TT
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);
1006 if (val == nullptr)
1007 {
1008 gdb_assert (type->code () == TYPE_CODE_TYPEDEF);
1009 fprintf_filtered (stream, "0x0");
1010 return;
1011 }
5b5e15ec 1012 }
57567375
TT
1013 else
1014 val = ada_to_fixed_value (val);
5b5e15ec 1015
5b5e15ec
TT
1016 type = value_type (val);
1017 struct type *saved_type = type;
1018
1019 const gdb_byte *valaddr = value_contents_for_printing (val);
1020 CORE_ADDR address = value_address (val);
b249d2c2
TT
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));
5b5e15ec
TT
1024 if (type != saved_type)
1025 {
1026 val = value_copy (val);
1027 deprecated_set_value_type (val, type);
1028 }
1029
09584414
JB
1030 if (is_fixed_point_type (type))
1031 type = fixed_point_type_base_type (type);
1032
78134374 1033 switch (type->code ())
5b5e15ec
TT
1034 {
1035 default:
1036 common_val_print (val, stream, recurse, options,
1037 language_def (language_c));
1038 break;
1039
1040 case TYPE_CODE_PTR:
416595d6 1041 ada_value_print_ptr (val, stream, recurse, options);
5b5e15ec
TT
1042 break;
1043
1044 case TYPE_CODE_INT:
1045 case TYPE_CODE_RANGE:
39ef85a8 1046 ada_value_print_num (val, stream, recurse, options);
5b5e15ec
TT
1047 break;
1048
1049 case TYPE_CODE_ENUM:
426a9c18 1050 ada_val_print_enum (val, stream, recurse, options);
5b5e15ec
TT
1051 break;
1052
1053 case TYPE_CODE_FLT:
b9fa6e07
TT
1054 if (options->format)
1055 {
1056 common_val_print (val, stream, recurse, options,
1057 language_def (language_c));
1058 break;
1059 }
1060
1061 ada_print_floating (valaddr, type, stream);
5b5e15ec
TT
1062 break;
1063
1064 case TYPE_CODE_UNION:
1065 case TYPE_CODE_STRUCT:
70304be9 1066 ada_val_print_struct_union (val, stream, recurse, options);
5b5e15ec
TT
1067 break;
1068
1069 case TYPE_CODE_ARRAY:
b59eac37 1070 ada_value_print_array (val, stream, recurse, options);
5b5e15ec
TT
1071 return;
1072
1073 case TYPE_CODE_REF:
1074 ada_val_print_ref (type, valaddr, 0, 0,
1075 address, stream, recurse, val,
1076 options);
1077 break;
1078 }
1079}
1080
26792ee0
TT
1081/* See ada-lang.h. */
1082
1083void
1084ada_value_print_inner (struct value *val, struct ui_file *stream,
1085 int recurse,
1086 const struct value_print_options *options)
1087{
5b5e15ec
TT
1088 try
1089 {
1090 ada_value_print_1 (val, stream, recurse, options);
1091 }
1092 catch (const gdb_exception_error &except)
1093 {
1094 fprintf_styled (stream, metadata_style.style (),
1095 _("<error reading variable: %s>"),
1096 except.what ());
1097 }
26792ee0
TT
1098}
1099
8e069a98 1100void
79a45b7d
TT
1101ada_value_print (struct value *val0, struct ui_file *stream,
1102 const struct value_print_options *options)
14f9c5c9 1103{
0c3acc09 1104 struct value *val = ada_to_fixed_value (val0);
cc330e39 1105 struct type *type = ada_check_typedef (value_type (val));
79a45b7d 1106 struct value_print_options opts;
14f9c5c9 1107
4c4b4cd2 1108 /* If it is a pointer, indicate what it points to. */
78134374 1109 if (type->code () == TYPE_CODE_PTR)
14f9c5c9 1110 {
4c4b4cd2 1111 /* Hack: don't print (char *) for char strings. Their
dda83cd7 1112 type is indicated by the quoted string anyway. */
4c4b4cd2 1113 if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
78134374 1114 || TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_INT
c6d940a9 1115 || TYPE_TARGET_TYPE (type)->is_unsigned ())
14f9c5c9
AS
1116 {
1117 fprintf_filtered (stream, "(");
1118 type_print (type, "", stream, -1);
1119 fprintf_filtered (stream, ") ");
1120 }
1121 }
4c4b4cd2 1122 else if (ada_is_array_descriptor_type (type))
14f9c5c9 1123 {
720d1a40
JB
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). */
78134374 1127 if (type->code () == TYPE_CODE_TYPEDEF)
dda83cd7 1128 {
720d1a40
JB
1129 fprintf_filtered (stream, "(");
1130 type_print (type, "", stream, -1);
1131 fprintf_filtered (stream, ") ");
1132 }
14f9c5c9
AS
1133 }
1134 else if (ada_is_bogus_array_descriptor (type))
1135 {
1136 fprintf_filtered (stream, "(");
1137 type_print (type, "", stream, -1);
1138 fprintf_filtered (stream, ") (...?)");
8e069a98 1139 return;
14f9c5c9 1140 }
4c4b4cd2 1141
79a45b7d
TT
1142 opts = *options;
1143 opts.deref_ref = 1;
03371129 1144 common_val_print (val, stream, 0, &opts, current_language);
14f9c5c9 1145}