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