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