build_type_unit_groups and moved closer to only caller and renamed
[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 <string.h>
23 #include "symtab.h"
24 #include "gdbtypes.h"
25 #include "expression.h"
26 #include "value.h"
27 #include "demangle.h"
28 #include "valprint.h"
29 #include "language.h"
30 #include "annotate.h"
31 #include "ada-lang.h"
32 #include "c-lang.h"
33 #include "infcall.h"
34 #include "exceptions.h"
35 #include "objfiles.h"
36
37 static int print_field_values (struct type *, const gdb_byte *,
38                                int,
39                                struct ui_file *, int,
40                                const struct value *,
41                                const struct value_print_options *,
42                                int, struct type *, int,
43                                const struct language_defn *);
44 \f
45
46 /* Make TYPE unsigned if its range of values includes no negatives.  */
47 static void
48 adjust_type_signedness (struct type *type)
49 {
50   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
51       && TYPE_LOW_BOUND (type) >= 0)
52     TYPE_UNSIGNED (type) = 1;
53 }
54
55 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
56    if non-standard (i.e., other than 1 for numbers, other than lower bound
57    of index type for enumerated type).  Returns 1 if something printed,
58    otherwise 0.  */
59
60 static int
61 print_optional_low_bound (struct ui_file *stream, struct type *type,
62                           const struct value_print_options *options)
63 {
64   struct type *index_type;
65   LONGEST low_bound;
66   LONGEST high_bound;
67
68   if (options->print_array_indexes)
69     return 0;
70
71   if (!get_array_bounds (type, &low_bound, &high_bound))
72     return 0;
73
74   /* If this is an empty array, then don't print the lower bound.
75      That would be confusing, because we would print the lower bound,
76      followed by... nothing!  */
77   if (low_bound > high_bound)
78     return 0;
79
80   index_type = TYPE_INDEX_TYPE (type);
81
82   while (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
83     {
84       /* We need to know what the base type is, in order to do the
85          appropriate check below.  Otherwise, if this is a subrange
86          of an enumerated type, where the underlying value of the
87          first element is typically 0, we might test the low bound
88          against the wrong value.  */
89       index_type = TYPE_TARGET_TYPE (index_type);
90     }
91
92   switch (TYPE_CODE (index_type))
93     {
94     case TYPE_CODE_BOOL:
95       if (low_bound == 0)
96         return 0;
97       break;
98     case TYPE_CODE_ENUM:
99       if (low_bound == TYPE_FIELD_ENUMVAL (index_type, 0))
100         return 0;
101       break;
102     case TYPE_CODE_UNDEF:
103       index_type = NULL;
104       /* FALL THROUGH */
105     default:
106       if (low_bound == 1)
107         return 0;
108       break;
109     }
110
111   ada_print_scalar (index_type, low_bound, stream);
112   fprintf_filtered (stream, " => ");
113   return 1;
114 }
115
116 /*  Version of val_print_array_elements for GNAT-style packed arrays.
117     Prints elements of packed array of type TYPE at bit offset
118     BITOFFSET from VALADDR on STREAM.  Formats according to OPTIONS and
119     separates with commas.  RECURSE is the recursion (nesting) level.
120     TYPE must have been decoded (as by ada_coerce_to_simple_array).  */
121
122 static void
123 val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
124                                  int offset,
125                                  int bitoffset, struct ui_file *stream,
126                                  int recurse,
127                                  const struct value *val,
128                                  const struct value_print_options *options)
129 {
130   unsigned int i;
131   unsigned int things_printed = 0;
132   unsigned len;
133   struct type *elttype, *index_type;
134   unsigned eltlen;
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   eltlen = TYPE_LENGTH (check_typedef (elttype));
141   index_type = TYPE_INDEX_TYPE (type);
142
143   {
144     LONGEST high;
145
146     if (get_discrete_bounds (index_type, &low, &high) < 0)
147       len = 1;
148     else
149       len = high - low + 1;
150   }
151
152   i = 0;
153   annotate_array_section_begin (i, elttype);
154
155   while (i < len && things_printed < options->print_max)
156     {
157       struct value *v0, *v1;
158       int i0;
159
160       if (i != 0)
161         {
162           if (options->prettyformat_arrays)
163             {
164               fprintf_filtered (stream, ",\n");
165               print_spaces_filtered (2 + 2 * recurse, stream);
166             }
167           else
168             {
169               fprintf_filtered (stream, ", ");
170             }
171         }
172       wrap_here (n_spaces (2 + 2 * recurse));
173       maybe_print_array_index (index_type, i + low, stream, options);
174
175       i0 = i;
176       v0 = ada_value_primitive_packed_val (NULL, valaddr + offset,
177                                            (i0 * bitsize) / HOST_CHAR_BIT,
178                                            (i0 * bitsize) % HOST_CHAR_BIT,
179                                            bitsize, elttype);
180       while (1)
181         {
182           i += 1;
183           if (i >= len)
184             break;
185           v1 = ada_value_primitive_packed_val (NULL, valaddr + offset,
186                                                (i * bitsize) / HOST_CHAR_BIT,
187                                                (i * bitsize) % HOST_CHAR_BIT,
188                                                bitsize, elttype);
189           if (!value_available_contents_eq (v0, value_embedded_offset (v0),
190                                             v1, value_embedded_offset (v1),
191                                             eltlen))
192             break;
193         }
194
195       if (i - i0 > options->repeat_count_threshold)
196         {
197           struct value_print_options opts = *options;
198
199           opts.deref_ref = 0;
200           val_print (elttype, value_contents_for_printing (v0),
201                      value_embedded_offset (v0), 0, stream,
202                      recurse + 1, v0, &opts, current_language);
203           annotate_elt_rep (i - i0);
204           fprintf_filtered (stream, _(" <repeats %u times>"), i - i0);
205           annotate_elt_rep_end ();
206
207         }
208       else
209         {
210           int j;
211           struct value_print_options opts = *options;
212
213           opts.deref_ref = 0;
214           for (j = i0; j < i; j += 1)
215             {
216               if (j > i0)
217                 {
218                   if (options->prettyformat_arrays)
219                     {
220                       fprintf_filtered (stream, ",\n");
221                       print_spaces_filtered (2 + 2 * recurse, stream);
222                     }
223                   else
224                     {
225                       fprintf_filtered (stream, ", ");
226                     }
227                   wrap_here (n_spaces (2 + 2 * recurse));
228                   maybe_print_array_index (index_type, j + low,
229                                            stream, options);
230                 }
231               val_print (elttype, value_contents_for_printing (v0),
232                          value_embedded_offset (v0), 0, stream,
233                          recurse + 1, v0, &opts, current_language);
234               annotate_elt ();
235             }
236         }
237       things_printed += i - i0;
238     }
239   annotate_array_section_end ();
240   if (i < len)
241     {
242       fprintf_filtered (stream, "...");
243     }
244
245   value_free_to_mark (mark);
246 }
247
248 static struct type *
249 printable_val_type (struct type *type, const gdb_byte *valaddr)
250 {
251   return ada_to_fixed_type (ada_aligned_type (type), valaddr, 0, NULL, 1);
252 }
253
254 /* Print the character C on STREAM as part of the contents of a literal
255    string whose delimiter is QUOTER.  TYPE_LEN is the length in bytes
256    of the character.  */
257
258 void
259 ada_emit_char (int c, struct type *type, struct ui_file *stream,
260                int quoter, int type_len)
261 {
262   /* If this character fits in the normal ASCII range, and is
263      a printable character, then print the character as if it was
264      an ASCII character, even if this is a wide character.
265      The UCHAR_MAX check is necessary because the isascii function
266      requires that its argument have a value of an unsigned char,
267      or EOF (EOF is obviously not printable).  */
268   if (c <= UCHAR_MAX && isascii (c) && isprint (c))
269     {
270       if (c == quoter && c == '"')
271         fprintf_filtered (stream, "\"\"");
272       else
273         fprintf_filtered (stream, "%c", c);
274     }
275   else
276     fprintf_filtered (stream, "[\"%0*x\"]", type_len * 2, c);
277 }
278
279 /* Character #I of STRING, given that TYPE_LEN is the size in bytes
280    of a character.  */
281
282 static int
283 char_at (const gdb_byte *string, int i, int type_len,
284          enum bfd_endian byte_order)
285 {
286   if (type_len == 1)
287     return string[i];
288   else
289     return (int) extract_unsigned_integer (string + type_len * i,
290                                            type_len, byte_order);
291 }
292
293 /* Print a floating-point value of type TYPE, pointed to in GDB by
294    VALADDR, on STREAM.  Use Ada formatting conventions: there must be
295    a decimal point, and at least one digit before and after the
296    point.  We use the GNAT format for NaNs and infinities.  */
297
298 static void
299 ada_print_floating (const gdb_byte *valaddr, struct type *type,
300                     struct ui_file *stream)
301 {
302   char *s, *result;
303   struct ui_file *tmp_stream = mem_fileopen ();
304   struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
305
306   print_floating (valaddr, type, tmp_stream);
307   result = ui_file_xstrdup (tmp_stream, NULL);
308   make_cleanup (xfree, result);
309
310   /* Modify for Ada rules.  */
311
312   s = strstr (result, "inf");
313   if (s == NULL)
314     s = strstr (result, "Inf");
315   if (s == NULL)
316     s = strstr (result, "INF");
317   if (s != NULL)
318     strcpy (s, "Inf");
319
320   if (s == NULL)
321     {
322       s = strstr (result, "nan");
323       if (s == NULL)
324         s = strstr (result, "NaN");
325       if (s == NULL)
326         s = strstr (result, "Nan");
327       if (s != NULL)
328         {
329           s[0] = s[2] = 'N';
330           if (result[0] == '-')
331             result += 1;
332         }
333     }
334
335   if (s == NULL && strchr (result, '.') == NULL)
336     {
337       s = strchr (result, 'e');
338       if (s == NULL)
339         fprintf_filtered (stream, "%s.0", result);
340       else
341         fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
342     }
343   else
344     fprintf_filtered (stream, "%s", result);
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   val_print (value_type (deref_val),
1061              value_contents_for_printing (deref_val),
1062              value_embedded_offset (deref_val),
1063              value_address (deref_val), stream, recurse + 1,
1064              deref_val, options, language);
1065 }
1066
1067 /* See the comment on ada_val_print.  This function differs in that it
1068    does not catch evaluation errors (leaving that to ada_val_print).  */
1069
1070 static void
1071 ada_val_print_1 (struct type *type, const gdb_byte *valaddr,
1072                  int offset, CORE_ADDR address,
1073                  struct ui_file *stream, int recurse,
1074                  const struct value *original_value,
1075                  const struct value_print_options *options,
1076                  const struct language_defn *language)
1077 {
1078   int offset_aligned;
1079
1080   type = ada_check_typedef (type);
1081
1082   if (ada_is_array_descriptor_type (type)
1083       || (ada_is_constrained_packed_array_type (type)
1084           && TYPE_CODE (type) != TYPE_CODE_PTR))
1085     {
1086       ada_val_print_gnat_array (type, valaddr, offset, address,
1087                                 stream, recurse, original_value,
1088                                 options, language);
1089       return;
1090     }
1091
1092   offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
1093   type = printable_val_type (type, valaddr + offset_aligned);
1094
1095   switch (TYPE_CODE (type))
1096     {
1097     default:
1098       val_print (type, valaddr, offset, address, stream, recurse,
1099                  original_value, options, language_def (language_c));
1100       break;
1101
1102     case TYPE_CODE_PTR:
1103       ada_val_print_ptr (type, valaddr, offset, offset_aligned,
1104                          address, stream, recurse, original_value,
1105                          options, language);
1106       break;
1107
1108     case TYPE_CODE_INT:
1109     case TYPE_CODE_RANGE:
1110       ada_val_print_num (type, valaddr, offset, offset_aligned,
1111                          address, stream, recurse, original_value,
1112                          options, language);
1113       break;
1114
1115     case TYPE_CODE_ENUM:
1116       ada_val_print_enum (type, valaddr, offset, offset_aligned,
1117                           address, stream, recurse, original_value,
1118                           options, language);
1119       break;
1120
1121     case TYPE_CODE_FLT:
1122       ada_val_print_flt (type, valaddr, offset, offset_aligned,
1123                          address, stream, recurse, original_value,
1124                          options, language);
1125       break;
1126
1127     case TYPE_CODE_UNION:
1128     case TYPE_CODE_STRUCT:
1129       ada_val_print_struct_union (type, valaddr, offset, offset_aligned,
1130                                   address, stream, recurse,
1131                                   original_value, options, language);
1132       break;
1133
1134     case TYPE_CODE_ARRAY:
1135       ada_val_print_array (type, valaddr, offset, offset_aligned,
1136                            address, stream, recurse, original_value,
1137                            options);
1138       return;
1139
1140     case TYPE_CODE_REF:
1141       ada_val_print_ref (type, valaddr, offset, offset_aligned,
1142                          address, stream, recurse, original_value,
1143                          options, language);
1144       break;
1145     }
1146 }
1147
1148 /* See val_print for a description of the various parameters of this
1149    function; they are identical.  */
1150
1151 void
1152 ada_val_print (struct type *type, const gdb_byte *valaddr,
1153                int embedded_offset, CORE_ADDR address,
1154                struct ui_file *stream, int recurse,
1155                const struct value *val,
1156                const struct value_print_options *options)
1157 {
1158   volatile struct gdb_exception except;
1159
1160   /* XXX: this catches QUIT/ctrl-c as well.  Isn't that busted?  */
1161   TRY_CATCH (except, RETURN_MASK_ALL)
1162     {
1163       ada_val_print_1 (type, valaddr, embedded_offset, address,
1164                        stream, recurse, val, options,
1165                        current_language);
1166     }
1167 }
1168
1169 void
1170 ada_value_print (struct value *val0, struct ui_file *stream,
1171                  const struct value_print_options *options)
1172 {
1173   struct value *val = ada_to_fixed_value (val0);
1174   CORE_ADDR address = value_address (val);
1175   struct type *type = ada_check_typedef (value_type (val));
1176   struct value_print_options opts;
1177
1178   /* If it is a pointer, indicate what it points to.  */
1179   if (TYPE_CODE (type) == TYPE_CODE_PTR)
1180     {
1181       /* Hack:  don't print (char *) for char strings.  Their
1182          type is indicated by the quoted string anyway.  */
1183       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
1184           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
1185           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
1186         {
1187           fprintf_filtered (stream, "(");
1188           type_print (type, "", stream, -1);
1189           fprintf_filtered (stream, ") ");
1190         }
1191     }
1192   else if (ada_is_array_descriptor_type (type))
1193     {
1194       /* We do not print the type description unless TYPE is an array
1195          access type (this is encoded by the compiler as a typedef to
1196          a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
1197       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
1198         {
1199           fprintf_filtered (stream, "(");
1200           type_print (type, "", stream, -1);
1201           fprintf_filtered (stream, ") ");
1202         }
1203     }
1204   else if (ada_is_bogus_array_descriptor (type))
1205     {
1206       fprintf_filtered (stream, "(");
1207       type_print (type, "", stream, -1);
1208       fprintf_filtered (stream, ") (...?)");
1209       return;
1210     }
1211
1212   opts = *options;
1213   opts.deref_ref = 1;
1214   val_print (type, value_contents_for_printing (val),
1215              value_embedded_offset (val), address,
1216              stream, 0, val, &opts, current_language);
1217 }