* valprint.h (struct generic_val_print_decorations): New.
[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_BITPOS (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_BITPOS (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   unsigned int len;
663   int i;
664   struct type *elttype;
665   LONGEST val;
666   int offset_aligned;
667
668   type = ada_check_typedef (type);
669
670   if (ada_is_array_descriptor_type (type)
671       || (ada_is_constrained_packed_array_type (type)
672           && TYPE_CODE (type) != TYPE_CODE_PTR))
673     {
674       struct value *mark = value_mark ();
675       struct value *val;
676
677       val = value_from_contents_and_address (type, valaddr + offset, address);
678       /* If this is a reference, coerce it now.  This helps taking care
679          of the case where ADDRESS is meaningless because original_value
680          was not an lval.  */
681       val = coerce_ref (val);
682       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
683         val = ada_coerce_to_simple_array_ptr (val);
684       else
685         val = ada_coerce_to_simple_array (val);
686       if (val == NULL)
687         {
688           gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
689           fprintf_filtered (stream, "0x0");
690         }
691       else
692         ada_val_print_1 (value_type (val),
693                          value_contents_for_printing (val),
694                          value_embedded_offset (val),
695                          value_address (val), stream, recurse,
696                          val, options);
697       value_free_to_mark (mark);
698       return;
699     }
700
701   offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
702   type = printable_val_type (type, valaddr + offset_aligned);
703
704   switch (TYPE_CODE (type))
705     {
706     default:
707       c_val_print (type, valaddr, offset, address, stream,
708                    recurse, original_value, options);
709       break;
710
711     case TYPE_CODE_PTR:
712       {
713         c_val_print (type, valaddr, offset, address,
714                      stream, recurse, original_value, options);
715
716         if (ada_is_tag_type (type))
717           {
718             struct value *val =
719               value_from_contents_and_address (type,
720                                                valaddr + offset_aligned,
721                                                address + offset_aligned);
722             const char *name = ada_tag_name (val);
723
724             if (name != NULL) 
725               fprintf_filtered (stream, " (%s)", name);
726           }
727         return;
728       }
729
730     case TYPE_CODE_INT:
731     case TYPE_CODE_RANGE:
732       if (ada_is_fixed_point_type (type))
733         {
734           LONGEST v = unpack_long (type, valaddr + offset_aligned);
735           int len = TYPE_LENGTH (type);
736
737           fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
738                             (double) ada_fixed_to_float (type, v));
739           return;
740         }
741       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
742         {
743           struct type *target_type = TYPE_TARGET_TYPE (type);
744
745           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
746             {
747               /* Obscure case of range type that has different length from
748                  its base type.  Perform a conversion, or we will get a
749                  nonsense value.  Actually, we could use the same
750                  code regardless of lengths; I'm just avoiding a cast.  */
751               struct value *v1
752                 = value_from_contents_and_address (type, valaddr + offset, 0);
753               struct value *v = value_cast (target_type, v1);
754
755               ada_val_print_1 (target_type,
756                                value_contents_for_printing (v),
757                                value_embedded_offset (v), 0,
758                                stream, recurse + 1, v, options);
759             }
760           else
761             ada_val_print_1 (TYPE_TARGET_TYPE (type),
762                              valaddr, offset,
763                              address, stream, recurse,
764                              original_value, options);
765           return;
766         }
767       else
768         {
769           int format = (options->format ? options->format
770                         : options->output_format);
771
772           if (format)
773             {
774               struct value_print_options opts = *options;
775
776               opts.format = format;
777               val_print_scalar_formatted (type, valaddr, offset_aligned,
778                                           original_value, &opts, 0, stream);
779             }
780           else if (ada_is_system_address_type (type))
781             {
782               /* FIXME: We want to print System.Address variables using
783                  the same format as for any access type.  But for some
784                  reason GNAT encodes the System.Address type as an int,
785                  so we have to work-around this deficiency by handling
786                  System.Address values as a special case.  */
787
788               struct gdbarch *gdbarch = get_type_arch (type);
789               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
790               CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
791                                                       ptr_type);
792
793               fprintf_filtered (stream, "(");
794               type_print (type, "", stream, -1);
795               fprintf_filtered (stream, ") ");
796               fputs_filtered (paddress (gdbarch, addr), stream);
797             }
798           else
799             {
800               val_print_type_code_int (type, valaddr + offset_aligned, stream);
801               if (ada_is_character_type (type))
802                 {
803                   LONGEST c;
804
805                   fputs_filtered (" ", stream);
806                   c = unpack_long (type, valaddr + offset_aligned);
807                   ada_printchar (c, type, stream);
808                 }
809             }
810           return;
811         }
812
813     case TYPE_CODE_ENUM:
814       if (options->format)
815         {
816           val_print_scalar_formatted (type, valaddr, offset_aligned,
817                                       original_value, options, 0, stream);
818           break;
819         }
820       len = TYPE_NFIELDS (type);
821       val = unpack_long (type, valaddr + offset_aligned);
822       for (i = 0; i < len; i++)
823         {
824           QUIT;
825           if (val == TYPE_FIELD_BITPOS (type, i))
826             {
827               break;
828             }
829         }
830       if (i < len)
831         {
832           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
833
834           if (name[0] == '\'')
835             fprintf_filtered (stream, "%ld %s", (long) val, name);
836           else
837             fputs_filtered (name, stream);
838         }
839       else
840         {
841           print_longest (stream, 'd', 0, val);
842         }
843       break;
844
845     case TYPE_CODE_FLT:
846       if (options->format)
847         {
848           c_val_print (type, valaddr, offset, address, stream,
849                        recurse, original_value, options);
850           return;
851         }
852       else
853         ada_print_floating (valaddr + offset, type, stream);
854       break;
855
856     case TYPE_CODE_UNION:
857     case TYPE_CODE_STRUCT:
858       if (ada_is_bogus_array_descriptor (type))
859         {
860           fprintf_filtered (stream, "(...?)");
861           return;
862         }
863       else
864         {
865           print_record (type, valaddr, offset_aligned,
866                         stream, recurse, original_value, options);
867           return;
868         }
869
870     case TYPE_CODE_ARRAY:
871       ada_val_print_array (type, valaddr, offset_aligned,
872                            address, stream, recurse, original_value,
873                            options);
874       return;
875
876     case TYPE_CODE_REF:
877       /* For references, the debugger is expected to print the value as
878          an address if DEREF_REF is null.  But printing an address in place
879          of the object value would be confusing to an Ada programmer.
880          So, for Ada values, we print the actual dereferenced value
881          regardless.  */
882       elttype = check_typedef (TYPE_TARGET_TYPE (type));
883       
884       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
885         {
886           CORE_ADDR deref_val_int;
887           struct value *deref_val;
888
889           deref_val = coerce_ref_if_computed (original_value);
890           if (deref_val)
891             {
892               common_val_print (deref_val, stream, recurse + 1, options,
893                                 current_language);
894               break;
895             }
896
897           deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
898           if (deref_val_int != 0)
899             {
900               struct value *deref_val =
901                 ada_value_ind (value_from_pointer
902                                (lookup_pointer_type (elttype),
903                                 deref_val_int));
904
905               val_print (value_type (deref_val),
906                          value_contents_for_printing (deref_val),
907                          value_embedded_offset (deref_val),
908                          value_address (deref_val), stream, recurse + 1,
909                          deref_val, options, current_language);
910             }
911           else
912             fputs_filtered ("(null)", stream);
913         }
914       else
915         fputs_filtered ("???", stream);
916
917       break;
918     }
919   gdb_flush (stream);
920 }
921
922 static int
923 print_variant_part (struct type *type, int field_num,
924                     const gdb_byte *valaddr, int offset,
925                     struct ui_file *stream, int recurse,
926                     const struct value *val,
927                     const struct value_print_options *options,
928                     int comma_needed,
929                     struct type *outer_type, int outer_offset)
930 {
931   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
932   int which = ada_which_variant_applies (var_type, outer_type,
933                                          valaddr + outer_offset);
934
935   if (which < 0)
936     return 0;
937   else
938     return print_field_values
939       (TYPE_FIELD_TYPE (var_type, which),
940        valaddr,
941        offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
942        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
943        stream, recurse, val, options,
944        comma_needed, outer_type, outer_offset);
945 }
946
947 void
948 ada_value_print (struct value *val0, struct ui_file *stream,
949                  const struct value_print_options *options)
950 {
951   struct value *val = ada_to_fixed_value (val0);
952   CORE_ADDR address = value_address (val);
953   struct type *type = ada_check_typedef (value_type (val));
954   struct value_print_options opts;
955
956   /* If it is a pointer, indicate what it points to.  */
957   if (TYPE_CODE (type) == TYPE_CODE_PTR)
958     {
959       /* Hack:  don't print (char *) for char strings.  Their
960          type is indicated by the quoted string anyway.  */
961       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
962           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
963           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
964         {
965           fprintf_filtered (stream, "(");
966           type_print (type, "", stream, -1);
967           fprintf_filtered (stream, ") ");
968         }
969     }
970   else if (ada_is_array_descriptor_type (type))
971     {
972       /* We do not print the type description unless TYPE is an array
973          access type (this is encoded by the compiler as a typedef to
974          a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
975       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
976         {
977           fprintf_filtered (stream, "(");
978           type_print (type, "", stream, -1);
979           fprintf_filtered (stream, ") ");
980         }
981     }
982   else if (ada_is_bogus_array_descriptor (type))
983     {
984       fprintf_filtered (stream, "(");
985       type_print (type, "", stream, -1);
986       fprintf_filtered (stream, ") (...?)");
987       return;
988     }
989
990   opts = *options;
991   opts.deref_ref = 1;
992   val_print (type, value_contents_for_printing (val),
993              value_embedded_offset (val), address,
994              stream, 0, val, &opts, current_language);
995 }
996
997 static void
998 print_record (struct type *type, const gdb_byte *valaddr,
999               int offset,
1000               struct ui_file *stream, int recurse,
1001               const struct value *val,
1002               const struct value_print_options *options)
1003 {
1004   type = ada_check_typedef (type);
1005
1006   fprintf_filtered (stream, "(");
1007
1008   if (print_field_values (type, valaddr, offset,
1009                           stream, recurse, val, options,
1010                           0, type, offset) != 0 && options->pretty)
1011     {
1012       fprintf_filtered (stream, "\n");
1013       print_spaces_filtered (2 * recurse, stream);
1014     }
1015
1016   fprintf_filtered (stream, ")");
1017 }
1018
1019 /* Print out fields of value at VALADDR + OFFSET having structure type TYPE.
1020
1021    TYPE, VALADDR, OFFSET, STREAM, RECURSE, and OPTIONS have the same
1022    meanings as in ada_print_value and ada_val_print.
1023
1024    OUTER_TYPE and OUTER_OFFSET give type and address of enclosing
1025    record (used to get discriminant values when printing variant
1026    parts).
1027
1028    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1029    level, so that a comma is needed before any field printed by this
1030    call.
1031
1032    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1033
1034 static int
1035 print_field_values (struct type *type, const gdb_byte *valaddr,
1036                     int offset, struct ui_file *stream, int recurse,
1037                     const struct value *val,
1038                     const struct value_print_options *options,
1039                     int comma_needed,
1040                     struct type *outer_type, int outer_offset)
1041 {
1042   int i, len;
1043
1044   len = TYPE_NFIELDS (type);
1045
1046   for (i = 0; i < len; i += 1)
1047     {
1048       if (ada_is_ignored_field (type, i))
1049         continue;
1050
1051       if (ada_is_wrapper_field (type, i))
1052         {
1053           comma_needed =
1054             print_field_values (TYPE_FIELD_TYPE (type, i),
1055                                 valaddr,
1056                                 (offset
1057                                  + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
1058                                 stream, recurse, val, options,
1059                                 comma_needed, type, offset);
1060           continue;
1061         }
1062       else if (ada_is_variant_part (type, i))
1063         {
1064           comma_needed =
1065             print_variant_part (type, i, valaddr,
1066                                 offset, stream, recurse, val,
1067                                 options, comma_needed,
1068                                 outer_type, outer_offset);
1069           continue;
1070         }
1071
1072       if (comma_needed)
1073         fprintf_filtered (stream, ", ");
1074       comma_needed = 1;
1075
1076       if (options->pretty)
1077         {
1078           fprintf_filtered (stream, "\n");
1079           print_spaces_filtered (2 + 2 * recurse, stream);
1080         }
1081       else
1082         {
1083           wrap_here (n_spaces (2 + 2 * recurse));
1084         }
1085       if (options->inspect_it)
1086         {
1087           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1088             fputs_filtered ("\"( ptr \"", stream);
1089           else
1090             fputs_filtered ("\"( nodef \"", stream);
1091           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1092                                    language_cplus, DMGL_NO_OPTS);
1093           fputs_filtered ("\" \"", stream);
1094           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1095                                    language_cplus, DMGL_NO_OPTS);
1096           fputs_filtered ("\") \"", stream);
1097         }
1098       else
1099         {
1100           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1101           fprintf_filtered (stream, "%.*s",
1102                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1103                             TYPE_FIELD_NAME (type, i));
1104           annotate_field_name_end ();
1105           fputs_filtered (" => ", stream);
1106           annotate_field_value ();
1107         }
1108
1109       if (TYPE_FIELD_PACKED (type, i))
1110         {
1111           struct value *v;
1112
1113           /* Bitfields require special handling, especially due to byte
1114              order problems.  */
1115           if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
1116             {
1117               fputs_filtered (_("<optimized out or zero length>"), stream);
1118             }
1119           else
1120             {
1121               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1122               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1123               struct value_print_options opts;
1124
1125               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1126               v = ada_value_primitive_packed_val
1127                     (NULL, valaddr,
1128                      offset + bit_pos / HOST_CHAR_BIT,
1129                      bit_pos % HOST_CHAR_BIT,
1130                      bit_size, TYPE_FIELD_TYPE (type, i));
1131               opts = *options;
1132               opts.deref_ref = 0;
1133               val_print (TYPE_FIELD_TYPE (type, i),
1134                          value_contents_for_printing (v),
1135                          value_embedded_offset (v), 0,
1136                          stream, recurse + 1, v,
1137                          &opts, current_language);
1138             }
1139         }
1140       else
1141         {
1142           struct value_print_options opts = *options;
1143
1144           opts.deref_ref = 0;
1145           ada_val_print (TYPE_FIELD_TYPE (type, i),
1146                          valaddr,
1147                          (offset
1148                           + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
1149                          0, stream, recurse + 1, val, &opts);
1150         }
1151       annotate_field_end ();
1152     }
1153
1154   return comma_needed;
1155 }