change section name in gdb/NEWS for changes in GDB 8.3
[external/binutils.git] / gdb / ada-valprint.c
1 /* Support for printing Ada values for GDB, the GNU debugger.
2
3    Copyright (C) 1986-2019 Free Software Foundation, Inc.
4
5    This file is part of GDB.
6
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.
11
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.
16
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/>.  */
19
20 #include "defs.h"
21 #include <ctype.h>
22 #include "symtab.h"
23 #include "gdbtypes.h"
24 #include "expression.h"
25 #include "value.h"
26 #include "demangle.h"
27 #include "valprint.h"
28 #include "language.h"
29 #include "annotate.h"
30 #include "ada-lang.h"
31 #include "c-lang.h"
32 #include "infcall.h"
33 #include "objfiles.h"
34 #include "target-float.h"
35
36 static int print_field_values (struct type *, const gdb_byte *,
37                                int,
38                                struct ui_file *, int,
39                                struct value *,
40                                const struct value_print_options *,
41                                int, struct type *, int,
42                                const struct language_defn *);
43 \f
44
45 /* Make TYPE unsigned if its range of values includes no negatives.  */
46 static void
47 adjust_type_signedness (struct type *type)
48 {
49   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
50       && TYPE_LOW_BOUND (type) >= 0)
51     TYPE_UNSIGNED (type) = 1;
52 }
53
54 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
55    if non-standard (i.e., other than 1 for numbers, other than lower bound
56    of index type for enumerated type).  Returns 1 if something printed,
57    otherwise 0.  */
58
59 static int
60 print_optional_low_bound (struct ui_file *stream, struct type *type,
61                           const struct value_print_options *options)
62 {
63   struct type *index_type;
64   LONGEST low_bound;
65   LONGEST high_bound;
66
67   if (options->print_array_indexes)
68     return 0;
69
70   if (!get_array_bounds (type, &low_bound, &high_bound))
71     return 0;
72
73   /* If this is an empty array, then don't print the lower bound.
74      That would be confusing, because we would print the lower bound,
75      followed by... nothing!  */
76   if (low_bound > high_bound)
77     return 0;
78
79   index_type = TYPE_INDEX_TYPE (type);
80
81   while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
82     {
83       /* We need to know what the base type is, in order to do the
84          appropriate check below.  Otherwise, if this is a subrange
85          of an enumerated type, where the underlying value of the
86          first element is typically 0, we might test the low bound
87          against the wrong value.  */
88       index_type = TYPE_TARGET_TYPE (index_type);
89     }
90
91   /* Don't print the lower bound if it's the default one.  */
92   switch (TYPE_CODE (index_type))
93     {
94     case TYPE_CODE_BOOL:
95     case TYPE_CODE_CHAR:
96       if (low_bound == 0)
97         return 0;
98       break;
99     case TYPE_CODE_ENUM:
100       if (low_bound == TYPE_FIELD_ENUMVAL (index_type, 0))
101         return 0;
102       break;
103     case TYPE_CODE_UNDEF:
104       index_type = NULL;
105       /* FALL THROUGH */
106     default:
107       if (low_bound == 1)
108         return 0;
109       break;
110     }
111
112   ada_print_scalar (index_type, low_bound, stream);
113   fprintf_filtered (stream, " => ");
114   return 1;
115 }
116
117 /*  Version of val_print_array_elements for GNAT-style packed arrays.
118     Prints elements of packed array of type TYPE at bit offset
119     BITOFFSET from VALADDR on STREAM.  Formats according to OPTIONS and
120     separates with commas.  RECURSE is the recursion (nesting) level.
121     TYPE must have been decoded (as by ada_coerce_to_simple_array).  */
122
123 static void
124 val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
125                                  int offset,
126                                  int bitoffset, struct ui_file *stream,
127                                  int recurse,
128                                  struct value *val,
129                                  const struct value_print_options *options)
130 {
131   unsigned int i;
132   unsigned int things_printed = 0;
133   unsigned len;
134   struct type *elttype, *index_type;
135   unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
136   struct value *mark = value_mark ();
137   LONGEST low = 0;
138
139   elttype = TYPE_TARGET_TYPE (type);
140   index_type = TYPE_INDEX_TYPE (type);
141
142   {
143     LONGEST high;
144     struct type *base_index_type;
145
146     if (get_discrete_bounds (index_type, &low, &high) < 0)
147       len = 1;
148     else
149       len = high - low + 1;
150
151     if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
152         base_index_type = TYPE_TARGET_TYPE (index_type);
153       else
154         base_index_type = index_type;
155
156     if (TYPE_CODE (base_index_type) == TYPE_CODE_ENUM)
157       {
158         LONGEST low_pos, high_pos;
159
160         /* Non-contiguous enumerations types can by used as index types
161            so the array length is computed from the positions of the
162            first and last literal in the enumeration type, and not from
163            the values of these literals.  */
164
165         if (!discrete_position (base_index_type, low, &low_pos)
166           || !discrete_position (base_index_type, high, &high_pos))
167           {
168             warning (_("unable to get positions in array, use bounds instead"));
169             low_pos = low;
170             high_pos = high;
171           }
172
173         /* The array length should normally be HIGH_POS - LOW_POS + 1.
174            But in Ada we allow LOW_POS to be greater than HIGH_POS for
175            empty arrays.  In that situation, the array length is just zero,
176            not negative!  */
177
178         if (low_pos > high_pos)
179           len = 0;
180         else
181           len = high_pos - low_pos + 1;
182       }
183   }
184
185   i = 0;
186   annotate_array_section_begin (i, elttype);
187
188   while (i < len && things_printed < options->print_max)
189     {
190       struct value *v0, *v1;
191       int i0;
192
193       if (i != 0)
194         {
195           if (options->prettyformat_arrays)
196             {
197               fprintf_filtered (stream, ",\n");
198               print_spaces_filtered (2 + 2 * recurse, stream);
199             }
200           else
201             {
202               fprintf_filtered (stream, ", ");
203             }
204         }
205       wrap_here (n_spaces (2 + 2 * recurse));
206       maybe_print_array_index (index_type, i + low, stream, options);
207
208       i0 = i;
209       v0 = ada_value_primitive_packed_val (NULL, valaddr + offset,
210                                            (i0 * bitsize) / HOST_CHAR_BIT,
211                                            (i0 * bitsize) % HOST_CHAR_BIT,
212                                            bitsize, elttype);
213       while (1)
214         {
215           i += 1;
216           if (i >= len)
217             break;
218           v1 = ada_value_primitive_packed_val (NULL, valaddr + offset,
219                                                (i * bitsize) / HOST_CHAR_BIT,
220                                                (i * bitsize) % HOST_CHAR_BIT,
221                                                bitsize, elttype);
222           if (TYPE_LENGTH (check_typedef (value_type (v0)))
223               != TYPE_LENGTH (check_typedef (value_type (v1))))
224             break;
225           if (!value_contents_eq (v0, value_embedded_offset (v0),
226                                   v1, value_embedded_offset (v1),
227                                   TYPE_LENGTH (check_typedef (value_type (v0)))))
228             break;
229         }
230
231       if (i - i0 > options->repeat_count_threshold)
232         {
233           struct value_print_options opts = *options;
234
235           opts.deref_ref = 0;
236           val_print (elttype,
237                      value_embedded_offset (v0), 0, stream,
238                      recurse + 1, v0, &opts, current_language);
239           annotate_elt_rep (i - i0);
240           fprintf_filtered (stream, _(" <repeats %u times>"), i - i0);
241           annotate_elt_rep_end ();
242
243         }
244       else
245         {
246           int j;
247           struct value_print_options opts = *options;
248
249           opts.deref_ref = 0;
250           for (j = i0; j < i; j += 1)
251             {
252               if (j > i0)
253                 {
254                   if (options->prettyformat_arrays)
255                     {
256                       fprintf_filtered (stream, ",\n");
257                       print_spaces_filtered (2 + 2 * recurse, stream);
258                     }
259                   else
260                     {
261                       fprintf_filtered (stream, ", ");
262                     }
263                   wrap_here (n_spaces (2 + 2 * recurse));
264                   maybe_print_array_index (index_type, j + low,
265                                            stream, options);
266                 }
267               val_print (elttype,
268                          value_embedded_offset (v0), 0, stream,
269                          recurse + 1, v0, &opts, current_language);
270               annotate_elt ();
271             }
272         }
273       things_printed += i - i0;
274     }
275   annotate_array_section_end ();
276   if (i < len)
277     {
278       fprintf_filtered (stream, "...");
279     }
280
281   value_free_to_mark (mark);
282 }
283
284 static struct type *
285 printable_val_type (struct type *type, const gdb_byte *valaddr)
286 {
287   return ada_to_fixed_type (ada_aligned_type (type), valaddr, 0, NULL, 1);
288 }
289
290 /* Print the character C on STREAM as part of the contents of a literal
291    string whose delimiter is QUOTER.  TYPE_LEN is the length in bytes
292    of the character.  */
293
294 void
295 ada_emit_char (int c, struct type *type, struct ui_file *stream,
296                int quoter, int type_len)
297 {
298   /* If this character fits in the normal ASCII range, and is
299      a printable character, then print the character as if it was
300      an ASCII character, even if this is a wide character.
301      The UCHAR_MAX check is necessary because the isascii function
302      requires that its argument have a value of an unsigned char,
303      or EOF (EOF is obviously not printable).  */
304   if (c <= UCHAR_MAX && isascii (c) && isprint (c))
305     {
306       if (c == quoter && c == '"')
307         fprintf_filtered (stream, "\"\"");
308       else
309         fprintf_filtered (stream, "%c", c);
310     }
311   else
312     fprintf_filtered (stream, "[\"%0*x\"]", type_len * 2, c);
313 }
314
315 /* Character #I of STRING, given that TYPE_LEN is the size in bytes
316    of a character.  */
317
318 static int
319 char_at (const gdb_byte *string, int i, int type_len,
320          enum bfd_endian byte_order)
321 {
322   if (type_len == 1)
323     return string[i];
324   else
325     return (int) extract_unsigned_integer (string + type_len * i,
326                                            type_len, byte_order);
327 }
328
329 /* Print a floating-point value of type TYPE, pointed to in GDB by
330    VALADDR, on STREAM.  Use Ada formatting conventions: there must be
331    a decimal point, and at least one digit before and after the
332    point.  We use the GNAT format for NaNs and infinities.  */
333
334 static void
335 ada_print_floating (const gdb_byte *valaddr, struct type *type,
336                     struct ui_file *stream)
337 {
338   string_file tmp_stream;
339
340   print_floating (valaddr, type, &tmp_stream);
341
342   std::string &s = tmp_stream.string ();
343   size_t skip_count = 0;
344
345   /* Modify for Ada rules.  */
346
347   size_t pos = s.find ("inf");
348   if (pos == std::string::npos)
349     pos = s.find ("Inf");
350   if (pos == std::string::npos)
351     pos = s.find ("INF");
352   if (pos != std::string::npos)
353     s.replace (pos, 3, "Inf");
354
355   if (pos == std::string::npos)
356     {
357       pos = s.find ("nan");
358       if (pos == std::string::npos)
359         pos = s.find ("NaN");
360       if (pos == std::string::npos)
361         pos = s.find ("Nan");
362       if (pos != std::string::npos)
363         {
364           s[pos] = s[pos + 2] = 'N';
365           if (s[0] == '-')
366             skip_count = 1;
367         }
368     }
369
370   if (pos == std::string::npos
371       && s.find ('.') == std::string::npos)
372     {
373       pos = s.find ('e');
374       if (pos == std::string::npos)
375         fprintf_filtered (stream, "%s.0", s.c_str ());
376       else
377         fprintf_filtered (stream, "%.*s.0%s", (int) pos, s.c_str (), &s[pos]);
378     }
379   else
380     fprintf_filtered (stream, "%s", &s[skip_count]);
381 }
382
383 void
384 ada_printchar (int c, struct type *type, struct ui_file *stream)
385 {
386   fputs_filtered ("'", stream);
387   ada_emit_char (c, type, stream, '\'', TYPE_LENGTH (type));
388   fputs_filtered ("'", stream);
389 }
390
391 /* [From print_type_scalar in typeprint.c].   Print VAL on STREAM in a
392    form appropriate for TYPE, if non-NULL.  If TYPE is NULL, print VAL
393    like a default signed integer.  */
394
395 void
396 ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
397 {
398   unsigned int i;
399   unsigned len;
400
401   if (!type)
402     {
403       print_longest (stream, 'd', 0, val);
404       return;
405     }
406
407   type = ada_check_typedef (type);
408
409   switch (TYPE_CODE (type))
410     {
411
412     case TYPE_CODE_ENUM:
413       len = TYPE_NFIELDS (type);
414       for (i = 0; i < len; i++)
415         {
416           if (TYPE_FIELD_ENUMVAL (type, i) == val)
417             {
418               break;
419             }
420         }
421       if (i < len)
422         {
423           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
424         }
425       else
426         {
427           print_longest (stream, 'd', 0, val);
428         }
429       break;
430
431     case TYPE_CODE_INT:
432       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
433       break;
434
435     case TYPE_CODE_CHAR:
436       LA_PRINT_CHAR (val, type, stream);
437       break;
438
439     case TYPE_CODE_BOOL:
440       fprintf_filtered (stream, val ? "true" : "false");
441       break;
442
443     case TYPE_CODE_RANGE:
444       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
445       return;
446
447     case TYPE_CODE_UNDEF:
448     case TYPE_CODE_PTR:
449     case TYPE_CODE_ARRAY:
450     case TYPE_CODE_STRUCT:
451     case TYPE_CODE_UNION:
452     case TYPE_CODE_FUNC:
453     case TYPE_CODE_FLT:
454     case TYPE_CODE_VOID:
455     case TYPE_CODE_SET:
456     case TYPE_CODE_STRING:
457     case TYPE_CODE_ERROR:
458     case TYPE_CODE_MEMBERPTR:
459     case TYPE_CODE_METHODPTR:
460     case TYPE_CODE_METHOD:
461     case TYPE_CODE_REF:
462       warning (_("internal error: unhandled type in ada_print_scalar"));
463       break;
464
465     default:
466       error (_("Invalid type code in symbol table."));
467     }
468   gdb_flush (stream);
469 }
470
471 /* Print the character string STRING, printing at most LENGTH characters.
472    Printing stops early if the number hits print_max; repeat counts
473    are printed as appropriate.  Print ellipses at the end if we
474    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
475    TYPE_LEN is the length (1 or 2) of the character type.  */
476
477 static void
478 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
479           unsigned int length, int force_ellipses, int type_len,
480           const struct value_print_options *options)
481 {
482   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (elttype));
483   unsigned int i;
484   unsigned int things_printed = 0;
485   int in_quotes = 0;
486   int need_comma = 0;
487
488   if (length == 0)
489     {
490       fputs_filtered ("\"\"", stream);
491       return;
492     }
493
494   for (i = 0; i < length && things_printed < options->print_max; i += 1)
495     {
496       /* Position of the character we are examining
497          to see whether it is repeated.  */
498       unsigned int rep1;
499       /* Number of repetitions we have detected so far.  */
500       unsigned int reps;
501
502       QUIT;
503
504       if (need_comma)
505         {
506           fputs_filtered (", ", stream);
507           need_comma = 0;
508         }
509
510       rep1 = i + 1;
511       reps = 1;
512       while (rep1 < length
513              && char_at (string, rep1, type_len, byte_order)
514                 == char_at (string, i, type_len, byte_order))
515         {
516           rep1 += 1;
517           reps += 1;
518         }
519
520       if (reps > options->repeat_count_threshold)
521         {
522           if (in_quotes)
523             {
524               fputs_filtered ("\", ", stream);
525               in_quotes = 0;
526             }
527           fputs_filtered ("'", stream);
528           ada_emit_char (char_at (string, i, type_len, byte_order),
529                          elttype, stream, '\'', type_len);
530           fputs_filtered ("'", stream);
531           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
532           i = rep1 - 1;
533           things_printed += options->repeat_count_threshold;
534           need_comma = 1;
535         }
536       else
537         {
538           if (!in_quotes)
539             {
540               fputs_filtered ("\"", stream);
541               in_quotes = 1;
542             }
543           ada_emit_char (char_at (string, i, type_len, byte_order),
544                          elttype, stream, '"', type_len);
545           things_printed += 1;
546         }
547     }
548
549   /* Terminate the quotes if necessary.  */
550   if (in_quotes)
551     fputs_filtered ("\"", stream);
552
553   if (force_ellipses || i < length)
554     fputs_filtered ("...", stream);
555 }
556
557 void
558 ada_printstr (struct ui_file *stream, struct type *type,
559               const gdb_byte *string, unsigned int length,
560               const char *encoding, int force_ellipses,
561               const struct value_print_options *options)
562 {
563   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
564             options);
565 }
566
567 static int
568 print_variant_part (struct type *type, int field_num,
569                     const gdb_byte *valaddr, int offset,
570                     struct ui_file *stream, int recurse,
571                     struct value *val,
572                     const struct value_print_options *options,
573                     int comma_needed,
574                     struct type *outer_type, int outer_offset,
575                     const struct language_defn *language)
576 {
577   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
578   int which = ada_which_variant_applies (var_type, outer_type,
579                                          valaddr + outer_offset);
580
581   if (which < 0)
582     return 0;
583   else
584     return print_field_values
585       (TYPE_FIELD_TYPE (var_type, which),
586        valaddr,
587        offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
588        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
589        stream, recurse, val, options,
590        comma_needed, outer_type, outer_offset, language);
591 }
592
593 /* Print out fields of value at VALADDR + OFFSET having structure type TYPE.
594
595    TYPE, VALADDR, OFFSET, STREAM, RECURSE, and OPTIONS have the same
596    meanings as in ada_print_value and ada_val_print.
597
598    OUTER_TYPE and OUTER_OFFSET give type and address of enclosing
599    record (used to get discriminant values when printing variant
600    parts).
601
602    COMMA_NEEDED is 1 if fields have been printed at the current recursion
603    level, so that a comma is needed before any field printed by this
604    call.
605
606    Returns 1 if COMMA_NEEDED or any fields were printed.  */
607
608 static int
609 print_field_values (struct type *type, const gdb_byte *valaddr,
610                     int offset, struct ui_file *stream, int recurse,
611                     struct value *val,
612                     const struct value_print_options *options,
613                     int comma_needed,
614                     struct type *outer_type, int outer_offset,
615                     const struct language_defn *language)
616 {
617   int i, len;
618
619   len = TYPE_NFIELDS (type);
620
621   for (i = 0; i < len; i += 1)
622     {
623       if (ada_is_ignored_field (type, i))
624         continue;
625
626       if (ada_is_wrapper_field (type, i))
627         {
628           comma_needed =
629             print_field_values (TYPE_FIELD_TYPE (type, i),
630                                 valaddr,
631                                 (offset
632                                  + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
633                                 stream, recurse, val, options,
634                                 comma_needed, type, offset, language);
635           continue;
636         }
637       else if (ada_is_variant_part (type, i))
638         {
639           comma_needed =
640             print_variant_part (type, i, valaddr,
641                                 offset, stream, recurse, val,
642                                 options, comma_needed,
643                                 outer_type, outer_offset, language);
644           continue;
645         }
646
647       if (comma_needed)
648         fprintf_filtered (stream, ", ");
649       comma_needed = 1;
650
651       if (options->prettyformat)
652         {
653           fprintf_filtered (stream, "\n");
654           print_spaces_filtered (2 + 2 * recurse, stream);
655         }
656       else
657         {
658           wrap_here (n_spaces (2 + 2 * recurse));
659         }
660
661       annotate_field_begin (TYPE_FIELD_TYPE (type, i));
662       fprintf_filtered (stream, "%.*s",
663                         ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
664                         TYPE_FIELD_NAME (type, i));
665       annotate_field_name_end ();
666       fputs_filtered (" => ", stream);
667       annotate_field_value ();
668
669       if (TYPE_FIELD_PACKED (type, i))
670         {
671           /* Bitfields require special handling, especially due to byte
672              order problems.  */
673           if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
674             {
675               fputs_filtered (_("<optimized out or zero length>"), stream);
676             }
677           else
678             {
679               struct value *v;
680               int bit_pos = TYPE_FIELD_BITPOS (type, i);
681               int bit_size = TYPE_FIELD_BITSIZE (type, i);
682               struct value_print_options opts;
683
684               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
685               v = ada_value_primitive_packed_val
686                     (NULL, valaddr,
687                      offset + bit_pos / HOST_CHAR_BIT,
688                      bit_pos % HOST_CHAR_BIT,
689                      bit_size, TYPE_FIELD_TYPE (type, i));
690               opts = *options;
691               opts.deref_ref = 0;
692               val_print (TYPE_FIELD_TYPE (type, i),
693                          value_embedded_offset (v), 0,
694                          stream, recurse + 1, v,
695                          &opts, language);
696             }
697         }
698       else
699         {
700           struct value_print_options opts = *options;
701
702           opts.deref_ref = 0;
703           val_print (TYPE_FIELD_TYPE (type, i),
704                      (offset + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
705                      0, stream, recurse + 1, val, &opts, language);
706         }
707       annotate_field_end ();
708     }
709
710   return comma_needed;
711 }
712
713 /* Implement Ada val_print'ing for the case where TYPE is
714    a TYPE_CODE_ARRAY of characters.  */
715
716 static void
717 ada_val_print_string (struct type *type, const gdb_byte *valaddr,
718                       int offset, int offset_aligned, CORE_ADDR address,
719                       struct ui_file *stream, int recurse,
720                       struct value *original_value,
721                       const struct value_print_options *options)
722 {
723   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
724   struct type *elttype = TYPE_TARGET_TYPE (type);
725   unsigned int eltlen;
726   unsigned int len;
727
728   /* We know that ELTTYPE cannot possibly be null, because we assume
729      that we're called only when TYPE is a string-like type.
730      Similarly, the size of ELTTYPE should also be non-null, since
731      it's a character-like type.  */
732   gdb_assert (elttype != NULL);
733   gdb_assert (TYPE_LENGTH (elttype) != 0);
734
735   eltlen = TYPE_LENGTH (elttype);
736   len = TYPE_LENGTH (type) / eltlen;
737
738   if (options->prettyformat_arrays)
739     print_spaces_filtered (2 + 2 * recurse, stream);
740
741   /* If requested, look for the first null char and only print
742      elements up to it.  */
743   if (options->stop_print_at_null)
744     {
745       int temp_len;
746
747       /* Look for a NULL char.  */
748       for (temp_len = 0;
749            (temp_len < len
750             && temp_len < options->print_max
751             && char_at (valaddr + offset_aligned,
752                         temp_len, eltlen, byte_order) != 0);
753            temp_len += 1);
754       len = temp_len;
755     }
756
757   printstr (stream, elttype, valaddr + offset_aligned, len, 0,
758             eltlen, options);
759 }
760
761 /* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers,
762    thin pointers, etc).  */
763
764 static void
765 ada_val_print_gnat_array (struct type *type, const gdb_byte *valaddr,
766                           int offset, CORE_ADDR address,
767                           struct ui_file *stream, int recurse,
768                           struct value *original_value,
769                           const struct value_print_options *options,
770                           const struct language_defn *language)
771 {
772   struct value *mark = value_mark ();
773   struct value *val;
774
775   val = value_from_contents_and_address (type, valaddr + offset, address);
776   /* If this is a reference, coerce it now.  This helps taking care
777      of the case where ADDRESS is meaningless because original_value
778      was not an lval.  */
779   val = coerce_ref (val);
780   if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
781     val = ada_coerce_to_simple_array_ptr (val);
782   else
783     val = ada_coerce_to_simple_array (val);
784   if (val == NULL)
785     {
786       gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
787       fprintf_filtered (stream, "0x0");
788     }
789   else
790     val_print (value_type (val),
791                value_embedded_offset (val), value_address (val),
792                stream, recurse, val, options, language);
793   value_free_to_mark (mark);
794 }
795
796 /* Implement Ada val_print'ing for the case where TYPE is
797    a TYPE_CODE_PTR.  */
798
799 static void
800 ada_val_print_ptr (struct type *type, const gdb_byte *valaddr,
801                    int offset, int offset_aligned, CORE_ADDR address,
802                    struct ui_file *stream, int recurse,
803                    struct value *original_value,
804                    const struct value_print_options *options,
805                    const struct language_defn *language)
806 {
807   val_print (type, offset, address, stream, recurse,
808              original_value, options, language_def (language_c));
809
810   if (ada_is_tag_type (type))
811     {
812       struct value *val =
813         value_from_contents_and_address (type,
814                                          valaddr + offset_aligned,
815                                          address + offset_aligned);
816       const char *name = ada_tag_name (val);
817
818       if (name != NULL)
819         fprintf_filtered (stream, " (%s)", name);
820     }
821 }
822
823 /* Implement Ada val_print'ing for the case where TYPE is
824    a TYPE_CODE_INT or TYPE_CODE_RANGE.  */
825
826 static void
827 ada_val_print_num (struct type *type, const gdb_byte *valaddr,
828                    int offset, int offset_aligned, CORE_ADDR address,
829                    struct ui_file *stream, int recurse,
830                    struct value *original_value,
831                    const struct value_print_options *options,
832                    const struct language_defn *language)
833 {
834   if (ada_is_fixed_point_type (type))
835     {
836       struct value *scale = ada_scaling_factor (type);
837       struct value *v = value_from_contents (type, valaddr + offset_aligned);
838       v = value_cast (value_type (scale), v);
839       v = value_binop (v, scale, BINOP_MUL);
840
841       const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g";
842       std::string str
843         = target_float_to_string (value_contents (v), value_type (v), fmt);
844       fputs_filtered (str.c_str (), stream);
845       return;
846     }
847   else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
848     {
849       struct type *target_type = TYPE_TARGET_TYPE (type);
850
851       if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
852         {
853           /* Obscure case of range type that has different length from
854              its base type.  Perform a conversion, or we will get a
855              nonsense value.  Actually, we could use the same
856              code regardless of lengths; I'm just avoiding a cast.  */
857           struct value *v1
858             = value_from_contents_and_address (type, valaddr + offset, 0);
859           struct value *v = value_cast (target_type, v1);
860
861           val_print (target_type,
862                      value_embedded_offset (v), 0, stream,
863                      recurse + 1, v, options, language);
864         }
865       else
866         val_print (TYPE_TARGET_TYPE (type), offset,
867                    address, stream, recurse, original_value,
868                    options, language);
869       return;
870     }
871   else
872     {
873       int format = (options->format ? options->format
874                     : options->output_format);
875
876       if (format)
877         {
878           struct value_print_options opts = *options;
879
880           opts.format = format;
881           val_print_scalar_formatted (type, offset_aligned,
882                                       original_value, &opts, 0, stream);
883         }
884       else if (ada_is_system_address_type (type))
885         {
886           /* FIXME: We want to print System.Address variables using
887              the same format as for any access type.  But for some
888              reason GNAT encodes the System.Address type as an int,
889              so we have to work-around this deficiency by handling
890              System.Address values as a special case.  */
891
892           struct gdbarch *gdbarch = get_type_arch (type);
893           struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
894           CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
895                                                   ptr_type);
896
897           fprintf_filtered (stream, "(");
898           type_print (type, "", stream, -1);
899           fprintf_filtered (stream, ") ");
900           fputs_filtered (paddress (gdbarch, addr), stream);
901         }
902       else
903         {
904           val_print_scalar_formatted (type, offset_aligned,
905                                       original_value, options, 0, stream);
906           if (ada_is_character_type (type))
907             {
908               LONGEST c;
909
910               fputs_filtered (" ", stream);
911               c = unpack_long (type, valaddr + offset_aligned);
912               ada_printchar (c, type, stream);
913             }
914         }
915       return;
916     }
917 }
918
919 /* Implement Ada val_print'ing for the case where TYPE is
920    a TYPE_CODE_ENUM.  */
921
922 static void
923 ada_val_print_enum (struct type *type, const gdb_byte *valaddr,
924                     int offset, int offset_aligned, CORE_ADDR address,
925                     struct ui_file *stream, int recurse,
926                     struct value *original_value,
927                     const struct value_print_options *options,
928                     const struct language_defn *language)
929 {
930   int i;
931   unsigned int len;
932   LONGEST val;
933
934   if (options->format)
935     {
936       val_print_scalar_formatted (type, offset_aligned,
937                                   original_value, options, 0, stream);
938       return;
939     }
940
941   len = TYPE_NFIELDS (type);
942   val = unpack_long (type, valaddr + offset_aligned);
943   for (i = 0; i < len; i++)
944     {
945       QUIT;
946       if (val == TYPE_FIELD_ENUMVAL (type, i))
947         break;
948     }
949
950   if (i < len)
951     {
952       const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
953
954       if (name[0] == '\'')
955         fprintf_filtered (stream, "%ld %s", (long) val, name);
956       else
957         fputs_filtered (name, stream);
958     }
959   else
960     print_longest (stream, 'd', 0, val);
961 }
962
963 /* Implement Ada val_print'ing for the case where TYPE is
964    a TYPE_CODE_FLT.  */
965
966 static void
967 ada_val_print_flt (struct type *type, const gdb_byte *valaddr,
968                    int offset, int offset_aligned, CORE_ADDR address,
969                    struct ui_file *stream, int recurse,
970                    struct value *original_value,
971                    const struct value_print_options *options,
972                    const struct language_defn *language)
973 {
974   if (options->format)
975     {
976       val_print (type, offset, address, stream, recurse,
977                  original_value, options, language_def (language_c));
978       return;
979     }
980
981   ada_print_floating (valaddr + offset, type, stream);
982 }
983
984 /* Implement Ada val_print'ing for the case where TYPE is
985    a TYPE_CODE_STRUCT or TYPE_CODE_UNION.  */
986
987 static void
988 ada_val_print_struct_union
989   (struct type *type, const gdb_byte *valaddr, int offset,
990    int offset_aligned, CORE_ADDR address, struct ui_file *stream,
991    int recurse, struct value *original_value,
992    const struct value_print_options *options,
993    const struct language_defn *language)
994 {
995   if (ada_is_bogus_array_descriptor (type))
996     {
997       fprintf_filtered (stream, "(...?)");
998       return;
999     }
1000
1001   fprintf_filtered (stream, "(");
1002
1003   if (print_field_values (type, valaddr, offset_aligned,
1004                           stream, recurse, original_value, options,
1005                           0, type, offset_aligned, language) != 0
1006       && options->prettyformat)
1007     {
1008       fprintf_filtered (stream, "\n");
1009       print_spaces_filtered (2 * recurse, stream);
1010     }
1011
1012   fprintf_filtered (stream, ")");
1013 }
1014
1015 /* Implement Ada val_print'ing for the case where TYPE is
1016    a TYPE_CODE_ARRAY.  */
1017
1018 static void
1019 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
1020                      int offset, int offset_aligned, CORE_ADDR address,
1021                      struct ui_file *stream, int recurse,
1022                      struct value *original_value,
1023                      const struct value_print_options *options)
1024 {
1025   /* For an array of characters, print with string syntax.  */
1026   if (ada_is_string_type (type)
1027       && (options->format == 0 || options->format == 's'))
1028     {
1029       ada_val_print_string (type, valaddr, offset, offset_aligned,
1030                             address, stream, recurse, original_value,
1031                             options);
1032       return;
1033     }
1034
1035   fprintf_filtered (stream, "(");
1036   print_optional_low_bound (stream, type, options);
1037   if (TYPE_FIELD_BITSIZE (type, 0) > 0)
1038     val_print_packed_array_elements (type, valaddr, offset_aligned,
1039                                      0, stream, recurse,
1040                                      original_value, options);
1041   else
1042     val_print_array_elements (type, offset_aligned, address,
1043                               stream, recurse, original_value,
1044                               options, 0);
1045   fprintf_filtered (stream, ")");
1046 }
1047
1048 /* Implement Ada val_print'ing for the case where TYPE is
1049    a TYPE_CODE_REF.  */
1050
1051 static void
1052 ada_val_print_ref (struct type *type, const gdb_byte *valaddr,
1053                    int offset, int offset_aligned, CORE_ADDR address,
1054                    struct ui_file *stream, int recurse,
1055                    struct value *original_value,
1056                    const struct value_print_options *options,
1057                    const struct language_defn *language)
1058 {
1059   /* For references, the debugger is expected to print the value as
1060      an address if DEREF_REF is null.  But printing an address in place
1061      of the object value would be confusing to an Ada programmer.
1062      So, for Ada values, we print the actual dereferenced value
1063      regardless.  */
1064   struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
1065   struct value *deref_val;
1066   CORE_ADDR deref_val_int;
1067
1068   if (TYPE_CODE (elttype) == TYPE_CODE_UNDEF)
1069     {
1070       fputs_filtered ("<ref to undefined type>", stream);
1071       return;
1072     }
1073
1074   deref_val = coerce_ref_if_computed (original_value);
1075   if (deref_val)
1076     {
1077       if (ada_is_tagged_type (value_type (deref_val), 1))
1078         deref_val = ada_tag_value_at_base_address (deref_val);
1079
1080       common_val_print (deref_val, stream, recurse + 1, options,
1081                         language);
1082       return;
1083     }
1084
1085   deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
1086   if (deref_val_int == 0)
1087     {
1088       fputs_filtered ("(null)", stream);
1089       return;
1090     }
1091
1092   deref_val
1093     = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype),
1094                                          deref_val_int));
1095   if (ada_is_tagged_type (value_type (deref_val), 1))
1096     deref_val = ada_tag_value_at_base_address (deref_val);
1097
1098   /* Make sure that the object does not have an unreasonable size
1099      before trying to print it.  This can happen for instance with
1100      references to dynamic objects whose contents is uninitialized
1101      (Eg: an array whose bounds are not set yet).  */
1102   ada_ensure_varsize_limit (value_type (deref_val));
1103
1104   if (value_lazy (deref_val))
1105     value_fetch_lazy (deref_val);
1106
1107   val_print (value_type (deref_val),
1108              value_embedded_offset (deref_val),
1109              value_address (deref_val), stream, recurse + 1,
1110              deref_val, options, language);
1111 }
1112
1113 /* See the comment on ada_val_print.  This function differs in that it
1114    does not catch evaluation errors (leaving that to ada_val_print).  */
1115
1116 static void
1117 ada_val_print_1 (struct type *type,
1118                  int offset, CORE_ADDR address,
1119                  struct ui_file *stream, int recurse,
1120                  struct value *original_value,
1121                  const struct value_print_options *options,
1122                  const struct language_defn *language)
1123 {
1124   int offset_aligned;
1125   const gdb_byte *valaddr = value_contents_for_printing (original_value);
1126
1127   type = ada_check_typedef (type);
1128
1129   if (ada_is_array_descriptor_type (type)
1130       || (ada_is_constrained_packed_array_type (type)
1131           && TYPE_CODE (type) != TYPE_CODE_PTR))
1132     {
1133       ada_val_print_gnat_array (type, valaddr, offset, address,
1134                                 stream, recurse, original_value,
1135                                 options, language);
1136       return;
1137     }
1138
1139   offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
1140   type = printable_val_type (type, valaddr + offset_aligned);
1141   type = resolve_dynamic_type (type, valaddr + offset_aligned,
1142                                address + offset_aligned);
1143
1144   switch (TYPE_CODE (type))
1145     {
1146     default:
1147       val_print (type, offset, address, stream, recurse,
1148                  original_value, options, language_def (language_c));
1149       break;
1150
1151     case TYPE_CODE_PTR:
1152       ada_val_print_ptr (type, valaddr, offset, offset_aligned,
1153                          address, stream, recurse, original_value,
1154                          options, language);
1155       break;
1156
1157     case TYPE_CODE_INT:
1158     case TYPE_CODE_RANGE:
1159       ada_val_print_num (type, valaddr, offset, offset_aligned,
1160                          address, stream, recurse, original_value,
1161                          options, language);
1162       break;
1163
1164     case TYPE_CODE_ENUM:
1165       ada_val_print_enum (type, valaddr, offset, offset_aligned,
1166                           address, stream, recurse, original_value,
1167                           options, language);
1168       break;
1169
1170     case TYPE_CODE_FLT:
1171       ada_val_print_flt (type, valaddr, offset, offset_aligned,
1172                          address, stream, recurse, original_value,
1173                          options, language);
1174       break;
1175
1176     case TYPE_CODE_UNION:
1177     case TYPE_CODE_STRUCT:
1178       ada_val_print_struct_union (type, valaddr, offset, offset_aligned,
1179                                   address, stream, recurse,
1180                                   original_value, options, language);
1181       break;
1182
1183     case TYPE_CODE_ARRAY:
1184       ada_val_print_array (type, valaddr, offset, offset_aligned,
1185                            address, stream, recurse, original_value,
1186                            options);
1187       return;
1188
1189     case TYPE_CODE_REF:
1190       ada_val_print_ref (type, valaddr, offset, offset_aligned,
1191                          address, stream, recurse, original_value,
1192                          options, language);
1193       break;
1194     }
1195 }
1196
1197 /* See val_print for a description of the various parameters of this
1198    function; they are identical.  */
1199
1200 void
1201 ada_val_print (struct type *type,
1202                int embedded_offset, CORE_ADDR address,
1203                struct ui_file *stream, int recurse,
1204                struct value *val,
1205                const struct value_print_options *options)
1206 {
1207   TRY
1208     {
1209       ada_val_print_1 (type, embedded_offset, address,
1210                        stream, recurse, val, options,
1211                        current_language);
1212     }
1213   CATCH (except, RETURN_MASK_ERROR)
1214     {
1215       fprintf_filtered (stream, _("<error reading variable: %s>"),
1216                         except.message);
1217     }
1218   END_CATCH
1219 }
1220
1221 void
1222 ada_value_print (struct value *val0, struct ui_file *stream,
1223                  const struct value_print_options *options)
1224 {
1225   struct value *val = ada_to_fixed_value (val0);
1226   CORE_ADDR address = value_address (val);
1227   struct type *type = ada_check_typedef (value_type (val));
1228   struct value_print_options opts;
1229
1230   /* If it is a pointer, indicate what it points to.  */
1231   if (TYPE_CODE (type) == TYPE_CODE_PTR)
1232     {
1233       /* Hack:  don't print (char *) for char strings.  Their
1234          type is indicated by the quoted string anyway.  */
1235       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
1236           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
1237           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
1238         {
1239           fprintf_filtered (stream, "(");
1240           type_print (type, "", stream, -1);
1241           fprintf_filtered (stream, ") ");
1242         }
1243     }
1244   else if (ada_is_array_descriptor_type (type))
1245     {
1246       /* We do not print the type description unless TYPE is an array
1247          access type (this is encoded by the compiler as a typedef to
1248          a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
1249       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
1250         {
1251           fprintf_filtered (stream, "(");
1252           type_print (type, "", stream, -1);
1253           fprintf_filtered (stream, ") ");
1254         }
1255     }
1256   else if (ada_is_bogus_array_descriptor (type))
1257     {
1258       fprintf_filtered (stream, "(");
1259       type_print (type, "", stream, -1);
1260       fprintf_filtered (stream, ") (...?)");
1261       return;
1262     }
1263
1264   opts = *options;
1265   opts.deref_ref = 1;
1266   val_print (type,
1267              value_embedded_offset (val), address,
1268              stream, 0, val, &opts, current_language);
1269 }