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