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