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