Fix PR win32/24284: tcp_auto_retry doesn't work in MinGW
[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 }
469
470 /* Print the character string STRING, printing at most LENGTH characters.
471    Printing stops early if the number hits print_max; repeat counts
472    are printed as appropriate.  Print ellipses at the end if we
473    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
474    TYPE_LEN is the length (1 or 2) of the character type.  */
475
476 static void
477 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
478           unsigned int length, int force_ellipses, int type_len,
479           const struct value_print_options *options)
480 {
481   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (elttype));
482   unsigned int i;
483   unsigned int things_printed = 0;
484   int in_quotes = 0;
485   int need_comma = 0;
486
487   if (length == 0)
488     {
489       fputs_filtered ("\"\"", stream);
490       return;
491     }
492
493   for (i = 0; i < length && things_printed < options->print_max; i += 1)
494     {
495       /* Position of the character we are examining
496          to see whether it is repeated.  */
497       unsigned int rep1;
498       /* Number of repetitions we have detected so far.  */
499       unsigned int reps;
500
501       QUIT;
502
503       if (need_comma)
504         {
505           fputs_filtered (", ", stream);
506           need_comma = 0;
507         }
508
509       rep1 = i + 1;
510       reps = 1;
511       while (rep1 < length
512              && char_at (string, rep1, type_len, byte_order)
513                 == char_at (string, i, type_len, byte_order))
514         {
515           rep1 += 1;
516           reps += 1;
517         }
518
519       if (reps > options->repeat_count_threshold)
520         {
521           if (in_quotes)
522             {
523               fputs_filtered ("\", ", stream);
524               in_quotes = 0;
525             }
526           fputs_filtered ("'", stream);
527           ada_emit_char (char_at (string, i, type_len, byte_order),
528                          elttype, stream, '\'', type_len);
529           fputs_filtered ("'", stream);
530           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
531           i = rep1 - 1;
532           things_printed += options->repeat_count_threshold;
533           need_comma = 1;
534         }
535       else
536         {
537           if (!in_quotes)
538             {
539               fputs_filtered ("\"", stream);
540               in_quotes = 1;
541             }
542           ada_emit_char (char_at (string, i, type_len, byte_order),
543                          elttype, stream, '"', type_len);
544           things_printed += 1;
545         }
546     }
547
548   /* Terminate the quotes if necessary.  */
549   if (in_quotes)
550     fputs_filtered ("\"", stream);
551
552   if (force_ellipses || i < length)
553     fputs_filtered ("...", stream);
554 }
555
556 void
557 ada_printstr (struct ui_file *stream, struct type *type,
558               const gdb_byte *string, unsigned int length,
559               const char *encoding, int force_ellipses,
560               const struct value_print_options *options)
561 {
562   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
563             options);
564 }
565
566 static int
567 print_variant_part (struct type *type, int field_num,
568                     const gdb_byte *valaddr, int offset,
569                     struct ui_file *stream, int recurse,
570                     struct value *val,
571                     const struct value_print_options *options,
572                     int comma_needed,
573                     struct type *outer_type, int outer_offset,
574                     const struct language_defn *language)
575 {
576   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
577   int which = ada_which_variant_applies (var_type, outer_type,
578                                          valaddr + outer_offset);
579
580   if (which < 0)
581     return 0;
582   else
583     return print_field_values
584       (TYPE_FIELD_TYPE (var_type, which),
585        valaddr,
586        offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
587        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
588        stream, recurse, val, options,
589        comma_needed, outer_type, outer_offset, language);
590 }
591
592 /* Print out fields of value at VALADDR + OFFSET having structure type TYPE.
593
594    TYPE, VALADDR, OFFSET, STREAM, RECURSE, and OPTIONS have the same
595    meanings as in ada_print_value and ada_val_print.
596
597    OUTER_TYPE and OUTER_OFFSET give type and address of enclosing
598    record (used to get discriminant values when printing variant
599    parts).
600
601    COMMA_NEEDED is 1 if fields have been printed at the current recursion
602    level, so that a comma is needed before any field printed by this
603    call.
604
605    Returns 1 if COMMA_NEEDED or any fields were printed.  */
606
607 static int
608 print_field_values (struct type *type, const gdb_byte *valaddr,
609                     int offset, struct ui_file *stream, int recurse,
610                     struct value *val,
611                     const struct value_print_options *options,
612                     int comma_needed,
613                     struct type *outer_type, int outer_offset,
614                     const struct language_defn *language)
615 {
616   int i, len;
617
618   len = TYPE_NFIELDS (type);
619
620   for (i = 0; i < len; i += 1)
621     {
622       if (ada_is_ignored_field (type, i))
623         continue;
624
625       if (ada_is_wrapper_field (type, i))
626         {
627           comma_needed =
628             print_field_values (TYPE_FIELD_TYPE (type, i),
629                                 valaddr,
630                                 (offset
631                                  + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
632                                 stream, recurse, val, options,
633                                 comma_needed, type, offset, language);
634           continue;
635         }
636       else if (ada_is_variant_part (type, i))
637         {
638           comma_needed =
639             print_variant_part (type, i, valaddr,
640                                 offset, stream, recurse, val,
641                                 options, comma_needed,
642                                 outer_type, outer_offset, language);
643           continue;
644         }
645
646       if (comma_needed)
647         fprintf_filtered (stream, ", ");
648       comma_needed = 1;
649
650       if (options->prettyformat)
651         {
652           fprintf_filtered (stream, "\n");
653           print_spaces_filtered (2 + 2 * recurse, stream);
654         }
655       else
656         {
657           wrap_here (n_spaces (2 + 2 * recurse));
658         }
659
660       annotate_field_begin (TYPE_FIELD_TYPE (type, i));
661       fprintf_filtered (stream, "%.*s",
662                         ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
663                         TYPE_FIELD_NAME (type, i));
664       annotate_field_name_end ();
665       fputs_filtered (" => ", stream);
666       annotate_field_value ();
667
668       if (TYPE_FIELD_PACKED (type, i))
669         {
670           /* Bitfields require special handling, especially due to byte
671              order problems.  */
672           if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
673             {
674               fputs_filtered (_("<optimized out or zero length>"), stream);
675             }
676           else
677             {
678               struct value *v;
679               int bit_pos = TYPE_FIELD_BITPOS (type, i);
680               int bit_size = TYPE_FIELD_BITSIZE (type, i);
681               struct value_print_options opts;
682
683               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
684               v = ada_value_primitive_packed_val
685                     (NULL, valaddr,
686                      offset + bit_pos / HOST_CHAR_BIT,
687                      bit_pos % HOST_CHAR_BIT,
688                      bit_size, TYPE_FIELD_TYPE (type, i));
689               opts = *options;
690               opts.deref_ref = 0;
691               val_print (TYPE_FIELD_TYPE (type, i),
692                          value_embedded_offset (v), 0,
693                          stream, recurse + 1, v,
694                          &opts, language);
695             }
696         }
697       else
698         {
699           struct value_print_options opts = *options;
700
701           opts.deref_ref = 0;
702           val_print (TYPE_FIELD_TYPE (type, i),
703                      (offset + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
704                      0, stream, recurse + 1, val, &opts, language);
705         }
706       annotate_field_end ();
707     }
708
709   return comma_needed;
710 }
711
712 /* Implement Ada val_print'ing for the case where TYPE is
713    a TYPE_CODE_ARRAY of characters.  */
714
715 static void
716 ada_val_print_string (struct type *type, const gdb_byte *valaddr,
717                       int offset, int offset_aligned, CORE_ADDR address,
718                       struct ui_file *stream, int recurse,
719                       struct value *original_value,
720                       const struct value_print_options *options)
721 {
722   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
723   struct type *elttype = TYPE_TARGET_TYPE (type);
724   unsigned int eltlen;
725   unsigned int len;
726
727   /* We know that ELTTYPE cannot possibly be null, because we assume
728      that we're called only when TYPE is a string-like type.
729      Similarly, the size of ELTTYPE should also be non-null, since
730      it's a character-like type.  */
731   gdb_assert (elttype != NULL);
732   gdb_assert (TYPE_LENGTH (elttype) != 0);
733
734   eltlen = TYPE_LENGTH (elttype);
735   len = TYPE_LENGTH (type) / eltlen;
736
737   if (options->prettyformat_arrays)
738     print_spaces_filtered (2 + 2 * recurse, stream);
739
740   /* If requested, look for the first null char and only print
741      elements up to it.  */
742   if (options->stop_print_at_null)
743     {
744       int temp_len;
745
746       /* Look for a NULL char.  */
747       for (temp_len = 0;
748            (temp_len < len
749             && temp_len < options->print_max
750             && char_at (valaddr + offset_aligned,
751                         temp_len, eltlen, byte_order) != 0);
752            temp_len += 1);
753       len = temp_len;
754     }
755
756   printstr (stream, elttype, valaddr + offset_aligned, len, 0,
757             eltlen, options);
758 }
759
760 /* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers,
761    thin pointers, etc).  */
762
763 static void
764 ada_val_print_gnat_array (struct type *type, const gdb_byte *valaddr,
765                           int offset, CORE_ADDR address,
766                           struct ui_file *stream, int recurse,
767                           struct value *original_value,
768                           const struct value_print_options *options)
769 {
770   struct value *mark = value_mark ();
771   struct value *val;
772
773   val = value_from_contents_and_address (type, valaddr + offset, address);
774   /* If this is a reference, coerce it now.  This helps taking care
775      of the case where ADDRESS is meaningless because original_value
776      was not an lval.  */
777   val = coerce_ref (val);
778   if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
779     val = ada_coerce_to_simple_array_ptr (val);
780   else
781     val = ada_coerce_to_simple_array (val);
782   if (val == NULL)
783     {
784       gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
785       fprintf_filtered (stream, "0x0");
786     }
787   else
788     val_print (value_type (val),
789                value_embedded_offset (val), value_address (val),
790                stream, recurse, val, options,
791                language_def (language_ada));
792   value_free_to_mark (mark);
793 }
794
795 /* Implement Ada val_print'ing for the case where TYPE is
796    a TYPE_CODE_PTR.  */
797
798 static void
799 ada_val_print_ptr (struct type *type, const gdb_byte *valaddr,
800                    int offset, int offset_aligned, CORE_ADDR address,
801                    struct ui_file *stream, int recurse,
802                    struct value *original_value,
803                    const struct value_print_options *options)
804 {
805   val_print (type, offset, address, stream, recurse,
806              original_value, options, language_def (language_c));
807
808   if (ada_is_tag_type (type))
809     {
810       struct value *val =
811         value_from_contents_and_address (type,
812                                          valaddr + offset_aligned,
813                                          address + offset_aligned);
814       const char *name = ada_tag_name (val);
815
816       if (name != NULL)
817         fprintf_filtered (stream, " (%s)", name);
818     }
819 }
820
821 /* Implement Ada val_print'ing for the case where TYPE is
822    a TYPE_CODE_INT or TYPE_CODE_RANGE.  */
823
824 static void
825 ada_val_print_num (struct type *type, const gdb_byte *valaddr,
826                    int offset, int offset_aligned, CORE_ADDR address,
827                    struct ui_file *stream, int recurse,
828                    struct value *original_value,
829                    const struct value_print_options *options)
830 {
831   if (ada_is_fixed_point_type (type))
832     {
833       struct value *scale = ada_scaling_factor (type);
834       struct value *v = value_from_contents (type, valaddr + offset_aligned);
835       v = value_cast (value_type (scale), v);
836       v = value_binop (v, scale, BINOP_MUL);
837
838       const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g";
839       std::string str
840         = target_float_to_string (value_contents (v), value_type (v), fmt);
841       fputs_filtered (str.c_str (), stream);
842       return;
843     }
844   else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
845     {
846       struct type *target_type = TYPE_TARGET_TYPE (type);
847
848       if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
849         {
850           /* Obscure case of range type that has different length from
851              its base type.  Perform a conversion, or we will get a
852              nonsense value.  Actually, we could use the same
853              code regardless of lengths; I'm just avoiding a cast.  */
854           struct value *v1
855             = value_from_contents_and_address (type, valaddr + offset, 0);
856           struct value *v = value_cast (target_type, v1);
857
858           val_print (target_type,
859                      value_embedded_offset (v), 0, stream,
860                      recurse + 1, v, options,
861                      language_def (language_ada));
862         }
863       else
864         val_print (TYPE_TARGET_TYPE (type), offset,
865                    address, stream, recurse, original_value,
866                    options, language_def (language_ada));
867       return;
868     }
869   else
870     {
871       int format = (options->format ? options->format
872                     : options->output_format);
873
874       if (format)
875         {
876           struct value_print_options opts = *options;
877
878           opts.format = format;
879           val_print_scalar_formatted (type, offset_aligned,
880                                       original_value, &opts, 0, stream);
881         }
882       else if (ada_is_system_address_type (type))
883         {
884           /* FIXME: We want to print System.Address variables using
885              the same format as for any access type.  But for some
886              reason GNAT encodes the System.Address type as an int,
887              so we have to work-around this deficiency by handling
888              System.Address values as a special case.  */
889
890           struct gdbarch *gdbarch = get_type_arch (type);
891           struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
892           CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
893                                                   ptr_type);
894
895           fprintf_filtered (stream, "(");
896           type_print (type, "", stream, -1);
897           fprintf_filtered (stream, ") ");
898           fputs_filtered (paddress (gdbarch, addr), stream);
899         }
900       else
901         {
902           val_print_scalar_formatted (type, offset_aligned,
903                                       original_value, options, 0, stream);
904           if (ada_is_character_type (type))
905             {
906               LONGEST c;
907
908               fputs_filtered (" ", stream);
909               c = unpack_long (type, valaddr + offset_aligned);
910               ada_printchar (c, type, stream);
911             }
912         }
913       return;
914     }
915 }
916
917 /* Implement Ada val_print'ing for the case where TYPE is
918    a TYPE_CODE_ENUM.  */
919
920 static void
921 ada_val_print_enum (struct type *type, const gdb_byte *valaddr,
922                     int offset, int offset_aligned, CORE_ADDR address,
923                     struct ui_file *stream, int recurse,
924                     struct value *original_value,
925                     const struct value_print_options *options)
926 {
927   int i;
928   unsigned int len;
929   LONGEST val;
930
931   if (options->format)
932     {
933       val_print_scalar_formatted (type, offset_aligned,
934                                   original_value, options, 0, stream);
935       return;
936     }
937
938   len = TYPE_NFIELDS (type);
939   val = unpack_long (type, valaddr + offset_aligned);
940   for (i = 0; i < len; i++)
941     {
942       QUIT;
943       if (val == TYPE_FIELD_ENUMVAL (type, i))
944         break;
945     }
946
947   if (i < len)
948     {
949       const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
950
951       if (name[0] == '\'')
952         fprintf_filtered (stream, "%ld %s", (long) val, name);
953       else
954         fputs_filtered (name, stream);
955     }
956   else
957     print_longest (stream, 'd', 0, val);
958 }
959
960 /* Implement Ada val_print'ing for the case where TYPE is
961    a TYPE_CODE_FLT.  */
962
963 static void
964 ada_val_print_flt (struct type *type, const gdb_byte *valaddr,
965                    int offset, int offset_aligned, CORE_ADDR address,
966                    struct ui_file *stream, int recurse,
967                    struct value *original_value,
968                    const struct value_print_options *options)
969 {
970   if (options->format)
971     {
972       val_print (type, offset, address, stream, recurse,
973                  original_value, options, language_def (language_c));
974       return;
975     }
976
977   ada_print_floating (valaddr + offset, type, stream);
978 }
979
980 /* Implement Ada val_print'ing for the case where TYPE is
981    a TYPE_CODE_STRUCT or TYPE_CODE_UNION.  */
982
983 static void
984 ada_val_print_struct_union
985   (struct type *type, const gdb_byte *valaddr, int offset,
986    int offset_aligned, CORE_ADDR address, struct ui_file *stream,
987    int recurse, struct value *original_value,
988    const struct value_print_options *options)
989 {
990   if (ada_is_bogus_array_descriptor (type))
991     {
992       fprintf_filtered (stream, "(...?)");
993       return;
994     }
995
996   fprintf_filtered (stream, "(");
997
998   if (print_field_values (type, valaddr, offset_aligned,
999                           stream, recurse, original_value, options,
1000                           0, type, offset_aligned,
1001                           language_def (language_ada)) != 0
1002       && options->prettyformat)
1003     {
1004       fprintf_filtered (stream, "\n");
1005       print_spaces_filtered (2 * recurse, stream);
1006     }
1007
1008   fprintf_filtered (stream, ")");
1009 }
1010
1011 /* Implement Ada val_print'ing for the case where TYPE is
1012    a TYPE_CODE_ARRAY.  */
1013
1014 static void
1015 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
1016                      int offset, int offset_aligned, CORE_ADDR address,
1017                      struct ui_file *stream, int recurse,
1018                      struct value *original_value,
1019                      const struct value_print_options *options)
1020 {
1021   /* For an array of characters, print with string syntax.  */
1022   if (ada_is_string_type (type)
1023       && (options->format == 0 || options->format == 's'))
1024     {
1025       ada_val_print_string (type, valaddr, offset, offset_aligned,
1026                             address, stream, recurse, original_value,
1027                             options);
1028       return;
1029     }
1030
1031   fprintf_filtered (stream, "(");
1032   print_optional_low_bound (stream, type, options);
1033   if (TYPE_FIELD_BITSIZE (type, 0) > 0)
1034     val_print_packed_array_elements (type, valaddr, offset_aligned,
1035                                      0, stream, recurse,
1036                                      original_value, options);
1037   else
1038     val_print_array_elements (type, offset_aligned, address,
1039                               stream, recurse, original_value,
1040                               options, 0);
1041   fprintf_filtered (stream, ")");
1042 }
1043
1044 /* Implement Ada val_print'ing for the case where TYPE is
1045    a TYPE_CODE_REF.  */
1046
1047 static void
1048 ada_val_print_ref (struct type *type, const gdb_byte *valaddr,
1049                    int offset, int offset_aligned, CORE_ADDR address,
1050                    struct ui_file *stream, int recurse,
1051                    struct value *original_value,
1052                    const struct value_print_options *options)
1053 {
1054   /* For references, the debugger is expected to print the value as
1055      an address if DEREF_REF is null.  But printing an address in place
1056      of the object value would be confusing to an Ada programmer.
1057      So, for Ada values, we print the actual dereferenced value
1058      regardless.  */
1059   struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
1060   struct value *deref_val;
1061   CORE_ADDR deref_val_int;
1062
1063   if (TYPE_CODE (elttype) == TYPE_CODE_UNDEF)
1064     {
1065       fputs_filtered ("<ref to undefined type>", stream);
1066       return;
1067     }
1068
1069   deref_val = coerce_ref_if_computed (original_value);
1070   if (deref_val)
1071     {
1072       if (ada_is_tagged_type (value_type (deref_val), 1))
1073         deref_val = ada_tag_value_at_base_address (deref_val);
1074
1075       common_val_print (deref_val, stream, recurse + 1, options,
1076                         language_def (language_ada));
1077       return;
1078     }
1079
1080   deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
1081   if (deref_val_int == 0)
1082     {
1083       fputs_filtered ("(null)", stream);
1084       return;
1085     }
1086
1087   deref_val
1088     = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype),
1089                                          deref_val_int));
1090   if (ada_is_tagged_type (value_type (deref_val), 1))
1091     deref_val = ada_tag_value_at_base_address (deref_val);
1092
1093   /* Make sure that the object does not have an unreasonable size
1094      before trying to print it.  This can happen for instance with
1095      references to dynamic objects whose contents is uninitialized
1096      (Eg: an array whose bounds are not set yet).  */
1097   ada_ensure_varsize_limit (value_type (deref_val));
1098
1099   if (value_lazy (deref_val))
1100     value_fetch_lazy (deref_val);
1101
1102   val_print (value_type (deref_val),
1103              value_embedded_offset (deref_val),
1104              value_address (deref_val), stream, recurse + 1,
1105              deref_val, options, language_def (language_ada));
1106 }
1107
1108 /* See the comment on ada_val_print.  This function differs in that it
1109    does not catch evaluation errors (leaving that to ada_val_print).  */
1110
1111 static void
1112 ada_val_print_1 (struct type *type,
1113                  int offset, CORE_ADDR address,
1114                  struct ui_file *stream, int recurse,
1115                  struct value *original_value,
1116                  const struct value_print_options *options)
1117 {
1118   int offset_aligned;
1119   const gdb_byte *valaddr = value_contents_for_printing (original_value);
1120
1121   type = ada_check_typedef (type);
1122
1123   if (ada_is_array_descriptor_type (type)
1124       || (ada_is_constrained_packed_array_type (type)
1125           && TYPE_CODE (type) != TYPE_CODE_PTR))
1126     {
1127       ada_val_print_gnat_array (type, valaddr, offset, address,
1128                                 stream, recurse, original_value,
1129                                 options);
1130       return;
1131     }
1132
1133   offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
1134   type = printable_val_type (type, valaddr + offset_aligned);
1135   type = resolve_dynamic_type (type, valaddr + offset_aligned,
1136                                address + offset_aligned);
1137
1138   switch (TYPE_CODE (type))
1139     {
1140     default:
1141       val_print (type, offset, address, stream, recurse,
1142                  original_value, options, language_def (language_c));
1143       break;
1144
1145     case TYPE_CODE_PTR:
1146       ada_val_print_ptr (type, valaddr, offset, offset_aligned,
1147                          address, stream, recurse, original_value,
1148                          options);
1149       break;
1150
1151     case TYPE_CODE_INT:
1152     case TYPE_CODE_RANGE:
1153       ada_val_print_num (type, valaddr, offset, offset_aligned,
1154                          address, stream, recurse, original_value,
1155                          options);
1156       break;
1157
1158     case TYPE_CODE_ENUM:
1159       ada_val_print_enum (type, valaddr, offset, offset_aligned,
1160                           address, stream, recurse, original_value,
1161                           options);
1162       break;
1163
1164     case TYPE_CODE_FLT:
1165       ada_val_print_flt (type, valaddr, offset, offset_aligned,
1166                          address, stream, recurse, original_value,
1167                          options);
1168       break;
1169
1170     case TYPE_CODE_UNION:
1171     case TYPE_CODE_STRUCT:
1172       ada_val_print_struct_union (type, valaddr, offset, offset_aligned,
1173                                   address, stream, recurse,
1174                                   original_value, options);
1175       break;
1176
1177     case TYPE_CODE_ARRAY:
1178       ada_val_print_array (type, valaddr, offset, offset_aligned,
1179                            address, stream, recurse, original_value,
1180                            options);
1181       return;
1182
1183     case TYPE_CODE_REF:
1184       ada_val_print_ref (type, valaddr, offset, offset_aligned,
1185                          address, stream, recurse, original_value,
1186                          options);
1187       break;
1188     }
1189 }
1190
1191 /* See val_print for a description of the various parameters of this
1192    function; they are identical.  */
1193
1194 void
1195 ada_val_print (struct type *type,
1196                int embedded_offset, CORE_ADDR address,
1197                struct ui_file *stream, int recurse,
1198                struct value *val,
1199                const struct value_print_options *options)
1200 {
1201   try
1202     {
1203       ada_val_print_1 (type, embedded_offset, address,
1204                        stream, recurse, val, options);
1205     }
1206   catch (const gdb_exception_error &except)
1207     {
1208       fprintf_filtered (stream, _("<error reading variable: %s>"),
1209                         except.what ());
1210     }
1211 }
1212
1213 void
1214 ada_value_print (struct value *val0, struct ui_file *stream,
1215                  const struct value_print_options *options)
1216 {
1217   struct value *val = ada_to_fixed_value (val0);
1218   CORE_ADDR address = value_address (val);
1219   struct type *type = ada_check_typedef (value_type (val));
1220   struct value_print_options opts;
1221
1222   /* If it is a pointer, indicate what it points to.  */
1223   if (TYPE_CODE (type) == TYPE_CODE_PTR)
1224     {
1225       /* Hack:  don't print (char *) for char strings.  Their
1226          type is indicated by the quoted string anyway.  */
1227       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
1228           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
1229           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
1230         {
1231           fprintf_filtered (stream, "(");
1232           type_print (type, "", stream, -1);
1233           fprintf_filtered (stream, ") ");
1234         }
1235     }
1236   else if (ada_is_array_descriptor_type (type))
1237     {
1238       /* We do not print the type description unless TYPE is an array
1239          access type (this is encoded by the compiler as a typedef to
1240          a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
1241       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
1242         {
1243           fprintf_filtered (stream, "(");
1244           type_print (type, "", stream, -1);
1245           fprintf_filtered (stream, ") ");
1246         }
1247     }
1248   else if (ada_is_bogus_array_descriptor (type))
1249     {
1250       fprintf_filtered (stream, "(");
1251       type_print (type, "", stream, -1);
1252       fprintf_filtered (stream, ") (...?)");
1253       return;
1254     }
1255
1256   opts = *options;
1257   opts.deref_ref = 1;
1258   val_print (type,
1259              value_embedded_offset (val), address,
1260              stream, 0, val, &opts, current_language);
1261 }