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