* ada-lang.c (packed_array_type): Rename to...
[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 Free 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 <ctype.h>
22 #include "defs.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 /* Encapsulates arguments to ada_val_print.  */
39 struct ada_val_print_args
40 {
41   struct type *type;
42   const gdb_byte *valaddr0;
43   int embedded_offset;
44   CORE_ADDR address;
45   struct ui_file *stream;
46   int recurse;
47   const struct value_print_options *options;
48 };
49
50 static void print_record (struct type *, const gdb_byte *, struct ui_file *,
51                           int, const struct value_print_options *);
52
53 static int print_field_values (struct type *, const gdb_byte *,
54                                struct ui_file *, int,
55                                const struct value_print_options *,
56                                int, struct type *,
57                                const gdb_byte *);
58
59 static void adjust_type_signedness (struct type *);
60
61 static int ada_val_print_stub (void *args0);
62
63 static int ada_val_print_1 (struct type *, const gdb_byte *, int, CORE_ADDR,
64                             struct ui_file *, int,
65                             const struct value_print_options *);
66 \f
67
68 /* Make TYPE unsigned if its range of values includes no negatives.  */
69 static void
70 adjust_type_signedness (struct type *type)
71 {
72   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
73       && TYPE_LOW_BOUND (type) >= 0)
74     TYPE_UNSIGNED (type) = 1;
75 }
76
77 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
78    if non-standard (i.e., other than 1 for numbers, other than lower bound
79    of index type for enumerated type).  Returns 1 if something printed,
80    otherwise 0.  */
81
82 static int
83 print_optional_low_bound (struct ui_file *stream, struct type *type,
84                           const struct value_print_options *options)
85 {
86   struct type *index_type;
87   long low_bound;
88   long high_bound;
89
90   if (options->print_array_indexes)
91     return 0;
92
93   if (!get_array_bounds (type, &low_bound, &high_bound))
94     return 0;
95
96   /* If this is an empty array, then don't print the lower bound.
97      That would be confusing, because we would print the lower bound,
98      followed by... nothing!  */
99   if (low_bound > high_bound)
100     return 0;
101
102   index_type = TYPE_INDEX_TYPE (type);
103
104   if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
105     {
106       /* We need to know what the base type is, in order to do the
107          appropriate check below.  Otherwise, if this is a subrange
108          of an enumerated type, where the underlying value of the
109          first element is typically 0, we might test the low bound
110          against the wrong value.  */
111       index_type = TYPE_TARGET_TYPE (index_type);
112     }
113
114   switch (TYPE_CODE (index_type))
115     {
116     case TYPE_CODE_BOOL:
117       if (low_bound == 0)
118         return 0;
119       break;
120     case TYPE_CODE_ENUM:
121       if (low_bound == TYPE_FIELD_BITPOS (index_type, 0))
122         return 0;
123       break;
124     case TYPE_CODE_UNDEF:
125       index_type = NULL;
126       /* FALL THROUGH */
127     default:
128       if (low_bound == 1)
129         return 0;
130       break;
131     }
132
133   ada_print_scalar (index_type, (LONGEST) low_bound, stream);
134   fprintf_filtered (stream, " => ");
135   return 1;
136 }
137
138 /*  Version of val_print_array_elements for GNAT-style packed arrays.
139     Prints elements of packed array of type TYPE at bit offset
140     BITOFFSET from VALADDR on STREAM.  Formats according to OPTIONS and
141     separates with commas.  RECURSE is the recursion (nesting) level.
142     TYPE must have been decoded (as by ada_coerce_to_simple_array).  */
143
144 static void
145 val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
146                                  int bitoffset, struct ui_file *stream,
147                                  int recurse,
148                                  const struct value_print_options *options)
149 {
150   unsigned int i;
151   unsigned int things_printed = 0;
152   unsigned len;
153   struct type *elttype, *index_type;
154   unsigned eltlen;
155   unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
156   struct value *mark = value_mark ();
157   LONGEST low = 0;
158
159   elttype = TYPE_TARGET_TYPE (type);
160   eltlen = TYPE_LENGTH (check_typedef (elttype));
161   index_type = TYPE_INDEX_TYPE (type);
162
163   {
164     LONGEST high;
165     if (get_discrete_bounds (index_type, &low, &high) < 0)
166       len = 1;
167     else
168       len = high - low + 1;
169   }
170
171   i = 0;
172   annotate_array_section_begin (i, elttype);
173
174   while (i < len && things_printed < options->print_max)
175     {
176       struct value *v0, *v1;
177       int i0;
178
179       if (i != 0)
180         {
181           if (options->prettyprint_arrays)
182             {
183               fprintf_filtered (stream, ",\n");
184               print_spaces_filtered (2 + 2 * recurse, stream);
185             }
186           else
187             {
188               fprintf_filtered (stream, ", ");
189             }
190         }
191       wrap_here (n_spaces (2 + 2 * recurse));
192       maybe_print_array_index (index_type, i + low, stream, options);
193
194       i0 = i;
195       v0 = ada_value_primitive_packed_val (NULL, valaddr,
196                                            (i0 * bitsize) / HOST_CHAR_BIT,
197                                            (i0 * bitsize) % HOST_CHAR_BIT,
198                                            bitsize, elttype);
199       while (1)
200         {
201           i += 1;
202           if (i >= len)
203             break;
204           v1 = ada_value_primitive_packed_val (NULL, valaddr,
205                                                (i * bitsize) / HOST_CHAR_BIT,
206                                                (i * bitsize) % HOST_CHAR_BIT,
207                                                bitsize, elttype);
208           if (memcmp (value_contents (v0), value_contents (v1), eltlen) != 0)
209             break;
210         }
211
212       if (i - i0 > options->repeat_count_threshold)
213         {
214           struct value_print_options opts = *options;
215           opts.deref_ref = 0;
216           val_print (elttype, value_contents (v0), 0, 0, stream,
217                      recurse + 1, &opts, current_language);
218           annotate_elt_rep (i - i0);
219           fprintf_filtered (stream, _(" <repeats %u times>"), i - i0);
220           annotate_elt_rep_end ();
221
222         }
223       else
224         {
225           int j;
226           struct value_print_options opts = *options;
227           opts.deref_ref = 0;
228           for (j = i0; j < i; j += 1)
229             {
230               if (j > i0)
231                 {
232                   if (options->prettyprint_arrays)
233                     {
234                       fprintf_filtered (stream, ",\n");
235                       print_spaces_filtered (2 + 2 * recurse, stream);
236                     }
237                   else
238                     {
239                       fprintf_filtered (stream, ", ");
240                     }
241                   wrap_here (n_spaces (2 + 2 * recurse));
242                   maybe_print_array_index (index_type, j + low,
243                                            stream, options);
244                 }
245               val_print (elttype, value_contents (v0), 0, 0, stream,
246                          recurse + 1, &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    (1 or 2) 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 (type_len != 2)
276     type_len = 1;
277
278   c &= (1 << (type_len * TARGET_CHAR_BIT)) - 1;
279
280   if (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 (1
292    or 2) 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 + 2 * i, 2, byte_order);
302 }
303
304 /* Wrapper around memcpy to make it legal argument to ui_file_put */
305 static void
306 ui_memcpy (void *dest, const char *buffer, long len)
307 {
308   memcpy (dest, buffer, (size_t) len);
309   ((char *) dest)[len] = '\0';
310 }
311
312 /* Print a floating-point value of type TYPE, pointed to in GDB by
313    VALADDR, on STREAM.  Use Ada formatting conventions: there must be
314    a decimal point, and at least one digit before and after the
315    point.  We use GNAT format for NaNs and infinities.  */
316 static void
317 ada_print_floating (const gdb_byte *valaddr, struct type *type,
318                     struct ui_file *stream)
319 {
320   char buffer[64];
321   char *s, *result;
322   int len;
323   struct ui_file *tmp_stream = mem_fileopen ();
324   struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
325
326   print_floating (valaddr, type, tmp_stream);
327   ui_file_put (tmp_stream, ui_memcpy, buffer);
328   do_cleanups (cleanups);
329
330   result = buffer;
331   len = strlen (result);
332
333   /* Modify for Ada rules.  */
334   
335   s = strstr (result, "inf");
336   if (s == NULL)
337     s = strstr (result, "Inf");
338   if (s == NULL)
339     s = strstr (result, "INF");
340   if (s != NULL)
341     strcpy (s, "Inf");
342
343   if (s == NULL)
344     {
345       s = strstr (result, "nan");
346       if (s == NULL)
347         s = strstr (result, "NaN");
348       if (s == NULL)
349         s = strstr (result, "Nan");
350       if (s != NULL)
351         {
352           s[0] = s[2] = 'N';
353           if (result[0] == '-')
354             result += 1;
355         }
356     }
357
358   if (s == NULL && strchr (result, '.') == NULL)
359     {
360       s = strchr (result, 'e');
361       if (s == NULL)
362         fprintf_filtered (stream, "%s.0", result);
363       else
364         fprintf_filtered (stream, "%.*s.0%s", (int) (s-result), result, s);
365       return;
366     }
367   fprintf_filtered (stream, "%s", result);
368 }
369
370 void
371 ada_printchar (int c, struct type *type, struct ui_file *stream)
372 {
373   fputs_filtered ("'", stream);
374   ada_emit_char (c, type, stream, '\'', 1);
375   fputs_filtered ("'", stream);
376 }
377
378 /* [From print_type_scalar in typeprint.c].   Print VAL on STREAM in a
379    form appropriate for TYPE, if non-NULL.  If TYPE is NULL, print VAL
380    like a default signed integer.  */
381
382 void
383 ada_print_scalar (struct type *type, LONGEST val, struct ui_file *stream)
384 {
385   unsigned int i;
386   unsigned len;
387
388   if (!type)
389     {
390       print_longest (stream, 'd', 0, val);
391       return;
392     }
393
394   type = ada_check_typedef (type);
395
396   switch (TYPE_CODE (type))
397     {
398
399     case TYPE_CODE_ENUM:
400       len = TYPE_NFIELDS (type);
401       for (i = 0; i < len; i++)
402         {
403           if (TYPE_FIELD_BITPOS (type, i) == val)
404             {
405               break;
406             }
407         }
408       if (i < len)
409         {
410           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
411         }
412       else
413         {
414           print_longest (stream, 'd', 0, val);
415         }
416       break;
417
418     case TYPE_CODE_INT:
419       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
420       break;
421
422     case TYPE_CODE_CHAR:
423       LA_PRINT_CHAR ((unsigned char) val, type, stream);
424       break;
425
426     case TYPE_CODE_BOOL:
427       fprintf_filtered (stream, val ? "true" : "false");
428       break;
429
430     case TYPE_CODE_RANGE:
431       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
432       return;
433
434     case TYPE_CODE_UNDEF:
435     case TYPE_CODE_PTR:
436     case TYPE_CODE_ARRAY:
437     case TYPE_CODE_STRUCT:
438     case TYPE_CODE_UNION:
439     case TYPE_CODE_FUNC:
440     case TYPE_CODE_FLT:
441     case TYPE_CODE_VOID:
442     case TYPE_CODE_SET:
443     case TYPE_CODE_STRING:
444     case TYPE_CODE_ERROR:
445     case TYPE_CODE_MEMBERPTR:
446     case TYPE_CODE_METHODPTR:
447     case TYPE_CODE_METHOD:
448     case TYPE_CODE_REF:
449       warning (_("internal error: unhandled type in ada_print_scalar"));
450       break;
451
452     default:
453       error (_("Invalid type code in symbol table."));
454     }
455   gdb_flush (stream);
456 }
457
458 /* Print the character string STRING, printing at most LENGTH characters.
459    Printing stops early if the number hits print_max; repeat counts
460    are printed as appropriate.  Print ellipses at the end if we
461    had to stop before printing LENGTH characters, or if
462    FORCE_ELLIPSES.   TYPE_LEN is the length (1 or 2) of the character type.
463  */
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, const gdb_byte *string,
558               unsigned int length, int force_ellipses,
559               const struct value_print_options *options)
560 {
561   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
562             options);
563 }
564
565
566 /* Print data of type TYPE located at VALADDR (within GDB), which came from
567    the inferior at address ADDRESS, onto stdio stream STREAM according to
568    OPTIONS.  The data at VALADDR is in target byte order.
569
570    If the data is printed as a string, returns the number of string characters
571    printed.
572
573    RECURSE indicates the amount of indentation to supply before
574    continuation lines; this amount is roughly twice the value of RECURSE.  */
575
576 int
577 ada_val_print (struct type *type, const gdb_byte *valaddr0,
578                int embedded_offset, CORE_ADDR address,
579                struct ui_file *stream, int recurse,
580                const struct value_print_options *options)
581 {
582   struct ada_val_print_args args;
583   args.type = type;
584   args.valaddr0 = valaddr0;
585   args.embedded_offset = embedded_offset;
586   args.address = address;
587   args.stream = stream;
588   args.recurse = recurse;
589   args.options = options;
590
591   return catch_errors (ada_val_print_stub, &args, NULL, RETURN_MASK_ALL);
592 }
593
594 /* Helper for ada_val_print; used as argument to catch_errors to
595    unmarshal the arguments to ada_val_print_1, which does the work.  */
596 static int
597 ada_val_print_stub (void *args0)
598 {
599   struct ada_val_print_args *argsp = (struct ada_val_print_args *) args0;
600   return ada_val_print_1 (argsp->type, argsp->valaddr0,
601                           argsp->embedded_offset, argsp->address,
602                           argsp->stream, argsp->recurse, argsp->options);
603 }
604
605 /* Assuming TYPE is a simple array, print the value of this array located
606    at VALADDR.  See ada_val_print for a description of the various
607    parameters of this function; they are identical.  The semantics
608    of the return value is also identical to ada_val_print.  */
609
610 static int
611 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
612                      CORE_ADDR address, struct ui_file *stream, int recurse,
613                      const struct value_print_options *options)
614 {
615   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
616   struct type *elttype = TYPE_TARGET_TYPE (type);
617   unsigned int eltlen;
618   unsigned int len;
619   int result = 0;
620
621   if (elttype == NULL)
622     eltlen = 0;
623   else
624     eltlen = TYPE_LENGTH (elttype);
625   if (eltlen == 0)
626     len = 0;
627   else
628     len = TYPE_LENGTH (type) / eltlen;
629
630   /* For an array of chars, print with string syntax.  */
631   if (ada_is_string_type (type)
632       && (options->format == 0 || options->format == 's'))
633     {
634       if (options->prettyprint_arrays)
635         print_spaces_filtered (2 + 2 * recurse, stream);
636
637       /* If requested, look for the first null char and only print
638          elements up to it.  */
639       if (options->stop_print_at_null)
640         {
641           int temp_len;
642
643           /* Look for a NULL char.  */
644           for (temp_len = 0;
645                (temp_len < len
646                 && temp_len < options->print_max
647                 && char_at (valaddr, temp_len, eltlen, byte_order) != 0);
648                temp_len += 1);
649           len = temp_len;
650         }
651
652       printstr (stream, elttype, valaddr, len, 0, eltlen, options);
653       result = len;
654     }
655   else
656     {
657       fprintf_filtered (stream, "(");
658       print_optional_low_bound (stream, type, options);
659       if (TYPE_FIELD_BITSIZE (type, 0) > 0)
660         val_print_packed_array_elements (type, valaddr, 0, stream,
661                                          recurse, options);
662       else
663         val_print_array_elements (type, valaddr, address, stream,
664                                   recurse, options, 0);
665       fprintf_filtered (stream, ")");
666     }
667
668   return result;
669 }
670
671 /* See the comment on ada_val_print.  This function differs in that it
672    does not catch evaluation errors (leaving that to ada_val_print).  */
673
674 static int
675 ada_val_print_1 (struct type *type, const gdb_byte *valaddr0,
676                  int embedded_offset, CORE_ADDR address,
677                  struct ui_file *stream, int recurse,
678                  const struct value_print_options *options)
679 {
680   unsigned int len;
681   int i;
682   struct type *elttype;
683   unsigned int eltlen;
684   LONGEST val;
685   const gdb_byte *valaddr = valaddr0 + embedded_offset;
686
687   type = ada_check_typedef (type);
688
689   if (ada_is_array_descriptor_type (type)
690       || ada_is_constrained_packed_array_type (type))
691     {
692       int retn;
693       struct value *mark = value_mark ();
694       struct value *val;
695       val = value_from_contents_and_address (type, valaddr, address);
696       val = ada_coerce_to_simple_array_ptr (val);
697       if (val == NULL)
698         {
699           fprintf_filtered (stream, "(null)");
700           retn = 0;
701         }
702       else
703         retn = ada_val_print_1 (value_type (val), value_contents (val), 0,
704                                 value_address (val), stream, recurse, options);
705       value_free_to_mark (mark);
706       return retn;
707     }
708
709   valaddr = ada_aligned_value_addr (type, valaddr);
710   embedded_offset -= valaddr - valaddr0 - embedded_offset;
711   type = printable_val_type (type, valaddr);
712
713   switch (TYPE_CODE (type))
714     {
715     default:
716       return c_val_print (type, valaddr0, embedded_offset, address, stream,
717                           recurse, options);
718
719     case TYPE_CODE_PTR:
720       {
721         int ret = c_val_print (type, valaddr0, embedded_offset, address, 
722                                stream, recurse, options);
723         if (ada_is_tag_type (type))
724           {
725             struct value *val = 
726               value_from_contents_and_address (type, valaddr, address);
727             const char *name = ada_tag_name (val);
728             if (name != NULL) 
729               fprintf_filtered (stream, " (%s)", name);
730             return 0;
731         }
732         return ret;
733       }
734
735     case TYPE_CODE_INT:
736     case TYPE_CODE_RANGE:
737       if (ada_is_fixed_point_type (type))
738         {
739           LONGEST v = unpack_long (type, valaddr);
740           int len = TYPE_LENGTH (type);
741
742           fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
743                             (double) ada_fixed_to_float (type, v));
744           return 0;
745         }
746       else if (ada_is_vax_floating_type (type))
747         {
748           struct value *val =
749             value_from_contents_and_address (type, valaddr, address);
750           struct value *func = ada_vax_float_print_function (type);
751           if (func != 0)
752             {
753               struct gdbarch *gdbarch = get_type_arch (type);
754               CORE_ADDR addr;
755               addr = value_as_address (call_function_by_hand (func, 1, &val));
756               val_print_string (builtin_type (gdbarch)->builtin_true_char,
757                                 addr, -1, stream, options);
758               return 0;
759             }
760           /* No special printing function.  Do as best we can.  */
761         }
762       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
763         {
764           struct type *target_type = TYPE_TARGET_TYPE (type);
765           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
766             {
767               /* Obscure case of range type that has different length from
768                  its base type.  Perform a conversion, or we will get a
769                  nonsense value.  Actually, we could use the same
770                  code regardless of lengths; I'm just avoiding a cast.  */
771               struct value *v = value_cast (target_type,
772                                             value_from_contents_and_address
773                                             (type, valaddr, 0));
774               return ada_val_print_1 (target_type, value_contents (v), 0, 0,
775                                       stream, recurse + 1, options);
776             }
777           else
778             return ada_val_print_1 (TYPE_TARGET_TYPE (type),
779                                     valaddr0, embedded_offset,
780                                     address, stream, recurse, options);
781         }
782       else
783         {
784           int format = (options->format ? options->format
785                         : options->output_format);
786           if (format)
787             {
788               struct value_print_options opts = *options;
789               opts.format = format;
790               print_scalar_formatted (valaddr, type, &opts, 0, stream);
791             }
792           else if (ada_is_system_address_type (type))
793             {
794               /* FIXME: We want to print System.Address variables using
795                  the same format as for any access type.  But for some
796                  reason GNAT encodes the System.Address type as an int,
797                  so we have to work-around this deficiency by handling
798                  System.Address values as a special case.  */
799
800               struct gdbarch *gdbarch = get_type_arch (type);
801               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
802               CORE_ADDR addr = extract_typed_address (valaddr, ptr_type);
803
804               fprintf_filtered (stream, "(");
805               type_print (type, "", stream, -1);
806               fprintf_filtered (stream, ") ");
807               fputs_filtered (paddress (gdbarch, addr), stream);
808             }
809           else
810             {
811               val_print_type_code_int (type, valaddr, stream);
812               if (ada_is_character_type (type))
813                 {
814                   fputs_filtered (" ", stream);
815                   ada_printchar ((unsigned char) unpack_long (type, valaddr),
816                                  type, stream);
817                 }
818             }
819           return 0;
820         }
821
822     case TYPE_CODE_ENUM:
823       if (options->format)
824         {
825           print_scalar_formatted (valaddr, type, options, 0, stream);
826           break;
827         }
828       len = TYPE_NFIELDS (type);
829       val = unpack_long (type, valaddr);
830       for (i = 0; i < len; i++)
831         {
832           QUIT;
833           if (val == TYPE_FIELD_BITPOS (type, i))
834             {
835               break;
836             }
837         }
838       if (i < len)
839         {
840           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
841           if (name[0] == '\'')
842             fprintf_filtered (stream, "%ld %s", (long) val, name);
843           else
844             fputs_filtered (name, stream);
845         }
846       else
847         {
848           print_longest (stream, 'd', 0, val);
849         }
850       break;
851
852     case TYPE_CODE_FLAGS:
853       if (options->format)
854         print_scalar_formatted (valaddr, type, options, 0, stream);
855       else
856         val_print_type_code_flags (type, valaddr, stream);
857       break;
858
859     case TYPE_CODE_FLT:
860       if (options->format)
861         return c_val_print (type, valaddr0, embedded_offset, address, stream,
862                             recurse, options);
863       else
864         ada_print_floating (valaddr0 + embedded_offset, type, stream);
865       break;
866
867     case TYPE_CODE_UNION:
868     case TYPE_CODE_STRUCT:
869       if (ada_is_bogus_array_descriptor (type))
870         {
871           fprintf_filtered (stream, "(...?)");
872           return 0;
873         }
874       else
875         {
876           print_record (type, valaddr, stream, recurse, options);
877           return 0;
878         }
879
880     case TYPE_CODE_ARRAY:
881       return ada_val_print_array (type, valaddr, address, stream,
882                                   recurse, options);
883
884     case TYPE_CODE_REF:
885       /* For references, the debugger is expected to print the value as
886          an address if DEREF_REF is null.  But printing an address in place
887          of the object value would be confusing to an Ada programmer.
888          So, for Ada values, we print the actual dereferenced value
889          regardless.  */
890       elttype = check_typedef (TYPE_TARGET_TYPE (type));
891       
892       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
893         {
894           LONGEST deref_val_int = (LONGEST) unpack_pointer (type, valaddr);
895           if (deref_val_int != 0)
896             {
897               struct value *deref_val =
898                 ada_value_ind (value_from_longest
899                                (lookup_pointer_type (elttype),
900                                 deref_val_int));
901               val_print (value_type (deref_val),
902                          value_contents (deref_val), 0,
903                          value_address (deref_val), stream, recurse + 1,
904                          options, current_language);
905             }
906           else
907             fputs_filtered ("(null)", stream);
908         }
909       else
910         fputs_filtered ("???", stream);
911
912       break;
913     }
914   gdb_flush (stream);
915   return 0;
916 }
917
918 static int
919 print_variant_part (struct type *type, int field_num, const gdb_byte *valaddr,
920                     struct ui_file *stream, int recurse,
921                     const struct value_print_options *options, int comma_needed,
922                     struct type *outer_type, const gdb_byte *outer_valaddr)
923 {
924   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
925   int which = ada_which_variant_applies (var_type, outer_type, outer_valaddr);
926
927   if (which < 0)
928     return 0;
929   else
930     return print_field_values
931       (TYPE_FIELD_TYPE (var_type, which),
932        valaddr + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
933        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
934        stream, recurse, options,
935        comma_needed, outer_type, outer_valaddr);
936 }
937
938 int
939 ada_value_print (struct value *val0, struct ui_file *stream,
940                  const struct value_print_options *options)
941 {
942   const gdb_byte *valaddr = value_contents (val0);
943   CORE_ADDR address = value_address (val0);
944   struct type *type =
945     ada_to_fixed_type (value_type (val0), valaddr, address, NULL, 1);
946   struct value *val =
947     value_from_contents_and_address (type, valaddr, address);
948   struct value_print_options opts;
949
950   /* If it is a pointer, indicate what it points to.  */
951   if (TYPE_CODE (type) == TYPE_CODE_PTR)
952     {
953       /* Hack:  don't print (char *) for char strings.  Their
954          type is indicated by the quoted string anyway.  */
955       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
956           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
957           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
958         {
959           fprintf_filtered (stream, "(");
960           type_print (type, "", stream, -1);
961           fprintf_filtered (stream, ") ");
962         }
963     }
964   else if (ada_is_array_descriptor_type (type))
965     {
966       fprintf_filtered (stream, "(");
967       type_print (type, "", stream, -1);
968       fprintf_filtered (stream, ") ");
969     }
970   else if (ada_is_bogus_array_descriptor (type))
971     {
972       fprintf_filtered (stream, "(");
973       type_print (type, "", stream, -1);
974       fprintf_filtered (stream, ") (...?)");
975       return 0;
976     }
977
978   opts = *options;
979   opts.deref_ref = 1;
980   return (val_print (type, value_contents (val), 0, address,
981                      stream, 0, &opts, current_language));
982 }
983
984 static void
985 print_record (struct type *type, const gdb_byte *valaddr,
986               struct ui_file *stream, int recurse,
987               const struct value_print_options *options)
988 {
989   type = ada_check_typedef (type);
990
991   fprintf_filtered (stream, "(");
992
993   if (print_field_values (type, valaddr, stream, recurse, options,
994                           0, type, valaddr) != 0 && options->pretty)
995     {
996       fprintf_filtered (stream, "\n");
997       print_spaces_filtered (2 * recurse, stream);
998     }
999
1000   fprintf_filtered (stream, ")");
1001 }
1002
1003 /* Print out fields of value at VALADDR having structure type TYPE.
1004
1005    TYPE, VALADDR, STREAM, RECURSE, and OPTIONS have the
1006    same meanings as in ada_print_value and ada_val_print.
1007
1008    OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
1009    (used to get discriminant values when printing variant parts).
1010
1011    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1012    level, so that a comma is needed before any field printed by this
1013    call.
1014
1015    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1016
1017 static int
1018 print_field_values (struct type *type, const gdb_byte *valaddr,
1019                     struct ui_file *stream, int recurse,
1020                     const struct value_print_options *options,
1021                     int comma_needed,
1022                     struct type *outer_type, const gdb_byte *outer_valaddr)
1023 {
1024   int i, len;
1025
1026   len = TYPE_NFIELDS (type);
1027
1028   for (i = 0; i < len; i += 1)
1029     {
1030       if (ada_is_ignored_field (type, i))
1031         continue;
1032
1033       if (ada_is_wrapper_field (type, i))
1034         {
1035           comma_needed =
1036             print_field_values (TYPE_FIELD_TYPE (type, i),
1037                                 valaddr
1038                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1039                                 stream, recurse, options,
1040                                 comma_needed, type, valaddr);
1041           continue;
1042         }
1043       else if (ada_is_variant_part (type, i))
1044         {
1045           comma_needed =
1046             print_variant_part (type, i, valaddr,
1047                                 stream, recurse, options, comma_needed,
1048                                 outer_type, outer_valaddr);
1049           continue;
1050         }
1051
1052       if (comma_needed)
1053         fprintf_filtered (stream, ", ");
1054       comma_needed = 1;
1055
1056       if (options->pretty)
1057         {
1058           fprintf_filtered (stream, "\n");
1059           print_spaces_filtered (2 + 2 * recurse, stream);
1060         }
1061       else
1062         {
1063           wrap_here (n_spaces (2 + 2 * recurse));
1064         }
1065       if (options->inspect_it)
1066         {
1067           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1068             fputs_filtered ("\"( ptr \"", stream);
1069           else
1070             fputs_filtered ("\"( nodef \"", stream);
1071           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1072                                    language_cplus, DMGL_NO_OPTS);
1073           fputs_filtered ("\" \"", stream);
1074           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1075                                    language_cplus, DMGL_NO_OPTS);
1076           fputs_filtered ("\") \"", stream);
1077         }
1078       else
1079         {
1080           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1081           fprintf_filtered (stream, "%.*s",
1082                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1083                             TYPE_FIELD_NAME (type, i));
1084           annotate_field_name_end ();
1085           fputs_filtered (" => ", stream);
1086           annotate_field_value ();
1087         }
1088
1089       if (TYPE_FIELD_PACKED (type, i))
1090         {
1091           struct value *v;
1092
1093           /* Bitfields require special handling, especially due to byte
1094              order problems.  */
1095           if (TYPE_CPLUS_SPECIFIC (type) != NULL
1096               && TYPE_FIELD_IGNORE (type, i))
1097             {
1098               fputs_filtered (_("<optimized out or zero length>"), stream);
1099             }
1100           else
1101             {
1102               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1103               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1104               struct value_print_options opts;
1105
1106               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1107               v = ada_value_primitive_packed_val (NULL, valaddr,
1108                                                   bit_pos / HOST_CHAR_BIT,
1109                                                   bit_pos % HOST_CHAR_BIT,
1110                                                   bit_size,
1111                                                   TYPE_FIELD_TYPE (type, i));
1112               opts = *options;
1113               opts.deref_ref = 0;
1114               val_print (TYPE_FIELD_TYPE (type, i), value_contents (v), 0, 0,
1115                          stream, recurse + 1, &opts, current_language);
1116             }
1117         }
1118       else
1119         {
1120           struct value_print_options opts = *options;
1121           opts.deref_ref = 0;
1122           ada_val_print (TYPE_FIELD_TYPE (type, i),
1123                          valaddr + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1124                          0, 0, stream, recurse + 1, &opts);
1125         }
1126       annotate_field_end ();
1127     }
1128
1129   return comma_needed;
1130 }