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