Full view of interface-wide types
[external/binutils.git] / gdb / ada-valprint.c
1 /* Support for printing Ada values for GDB, the GNU debugger.
2
3    Copyright (C) 1986, 1988-1989, 1991-1994, 1997, 2001-2012 Free
4    Software Foundation, Inc.
5
6    This file is part of GDB.
7
8    This program is free software; you can redistribute it and/or modify
9    it under the terms of the GNU General Public License as published by
10    the Free Software Foundation; either version 3 of the License, or
11    (at your option) any later version.
12
13    This program is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16    GNU General Public License for more details.
17
18    You should have received a copy of the GNU General Public License
19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
20
21 #include "defs.h"
22 #include <ctype.h>
23 #include "gdb_string.h"
24 #include "symtab.h"
25 #include "gdbtypes.h"
26 #include "expression.h"
27 #include "value.h"
28 #include "demangle.h"
29 #include "valprint.h"
30 #include "language.h"
31 #include "annotate.h"
32 #include "ada-lang.h"
33 #include "c-lang.h"
34 #include "infcall.h"
35 #include "exceptions.h"
36 #include "objfiles.h"
37
38 static void print_record (struct type *, const gdb_byte *, int,
39                           struct ui_file *,
40                           int,
41                           const struct value *,
42                           const struct value_print_options *);
43
44 static int print_field_values (struct type *, const gdb_byte *,
45                                int,
46                                struct ui_file *, int,
47                                const struct value *,
48                                const struct value_print_options *,
49                                int, struct type *, int);
50
51 static void adjust_type_signedness (struct type *);
52
53 static void ada_val_print_1 (struct type *, const gdb_byte *, int, CORE_ADDR,
54                              struct ui_file *, int,
55                              const struct value *,
56                              const struct value_print_options *);
57 \f
58
59 /* Make TYPE unsigned if its range of values includes no negatives.  */
60 static void
61 adjust_type_signedness (struct type *type)
62 {
63   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
64       && TYPE_LOW_BOUND (type) >= 0)
65     TYPE_UNSIGNED (type) = 1;
66 }
67
68 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
69    if non-standard (i.e., other than 1 for numbers, other than lower bound
70    of index type for enumerated type).  Returns 1 if something printed,
71    otherwise 0.  */
72
73 static int
74 print_optional_low_bound (struct ui_file *stream, struct type *type,
75                           const struct value_print_options *options)
76 {
77   struct type *index_type;
78   LONGEST low_bound;
79   LONGEST high_bound;
80
81   if (options->print_array_indexes)
82     return 0;
83
84   if (!get_array_bounds (type, &low_bound, &high_bound))
85     return 0;
86
87   /* If this is an empty array, then don't print the lower bound.
88      That would be confusing, because we would print the lower bound,
89      followed by... nothing!  */
90   if (low_bound > high_bound)
91     return 0;
92
93   index_type = TYPE_INDEX_TYPE (type);
94
95   if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
96     {
97       /* We need to know what the base type is, in order to do the
98          appropriate check below.  Otherwise, if this is a subrange
99          of an enumerated type, where the underlying value of the
100          first element is typically 0, we might test the low bound
101          against the wrong value.  */
102       index_type = TYPE_TARGET_TYPE (index_type);
103     }
104
105   switch (TYPE_CODE (index_type))
106     {
107     case TYPE_CODE_BOOL:
108       if (low_bound == 0)
109         return 0;
110       break;
111     case TYPE_CODE_ENUM:
112       if (low_bound == TYPE_FIELD_ENUMVAL (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_ENUMVAL (type, i) == val)
406             {
407               break;
408             }
409         }
410       if (i < len)
411         {
412           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
413         }
414       else
415         {
416           print_longest (stream, 'd', 0, val);
417         }
418       break;
419
420     case TYPE_CODE_INT:
421       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
422       break;
423
424     case TYPE_CODE_CHAR:
425       LA_PRINT_CHAR (val, type, stream);
426       break;
427
428     case TYPE_CODE_BOOL:
429       fprintf_filtered (stream, val ? "true" : "false");
430       break;
431
432     case TYPE_CODE_RANGE:
433       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
434       return;
435
436     case TYPE_CODE_UNDEF:
437     case TYPE_CODE_PTR:
438     case TYPE_CODE_ARRAY:
439     case TYPE_CODE_STRUCT:
440     case TYPE_CODE_UNION:
441     case TYPE_CODE_FUNC:
442     case TYPE_CODE_FLT:
443     case TYPE_CODE_VOID:
444     case TYPE_CODE_SET:
445     case TYPE_CODE_STRING:
446     case TYPE_CODE_ERROR:
447     case TYPE_CODE_MEMBERPTR:
448     case TYPE_CODE_METHODPTR:
449     case TYPE_CODE_METHOD:
450     case TYPE_CODE_REF:
451       warning (_("internal error: unhandled type in ada_print_scalar"));
452       break;
453
454     default:
455       error (_("Invalid type code in symbol table."));
456     }
457   gdb_flush (stream);
458 }
459
460 /* Print the character string STRING, printing at most LENGTH characters.
461    Printing stops early if the number hits print_max; repeat counts
462    are printed as appropriate.  Print ellipses at the end if we
463    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
464    TYPE_LEN is the length (1 or 2) of the character type.  */
465
466 static void
467 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
468           unsigned int length, int force_ellipses, int type_len,
469           const struct value_print_options *options)
470 {
471   enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (elttype));
472   unsigned int i;
473   unsigned int things_printed = 0;
474   int in_quotes = 0;
475   int need_comma = 0;
476
477   if (length == 0)
478     {
479       fputs_filtered ("\"\"", stream);
480       return;
481     }
482
483   for (i = 0; i < length && things_printed < options->print_max; i += 1)
484     {
485       /* Position of the character we are examining
486          to see whether it is repeated.  */
487       unsigned int rep1;
488       /* Number of repetitions we have detected so far.  */
489       unsigned int reps;
490
491       QUIT;
492
493       if (need_comma)
494         {
495           fputs_filtered (", ", stream);
496           need_comma = 0;
497         }
498
499       rep1 = i + 1;
500       reps = 1;
501       while (rep1 < length
502              && char_at (string, rep1, type_len, byte_order)
503                 == char_at (string, i, type_len, byte_order))
504         {
505           rep1 += 1;
506           reps += 1;
507         }
508
509       if (reps > options->repeat_count_threshold)
510         {
511           if (in_quotes)
512             {
513               if (options->inspect_it)
514                 fputs_filtered ("\\\", ", stream);
515               else
516                 fputs_filtered ("\", ", stream);
517               in_quotes = 0;
518             }
519           fputs_filtered ("'", stream);
520           ada_emit_char (char_at (string, i, type_len, byte_order),
521                          elttype, stream, '\'', type_len);
522           fputs_filtered ("'", stream);
523           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
524           i = rep1 - 1;
525           things_printed += options->repeat_count_threshold;
526           need_comma = 1;
527         }
528       else
529         {
530           if (!in_quotes)
531             {
532               if (options->inspect_it)
533                 fputs_filtered ("\\\"", stream);
534               else
535                 fputs_filtered ("\"", stream);
536               in_quotes = 1;
537             }
538           ada_emit_char (char_at (string, i, type_len, byte_order),
539                          elttype, stream, '"', type_len);
540           things_printed += 1;
541         }
542     }
543
544   /* Terminate the quotes if necessary.  */
545   if (in_quotes)
546     {
547       if (options->inspect_it)
548         fputs_filtered ("\\\"", stream);
549       else
550         fputs_filtered ("\"", stream);
551     }
552
553   if (force_ellipses || i < length)
554     fputs_filtered ("...", stream);
555 }
556
557 void
558 ada_printstr (struct ui_file *stream, struct type *type,
559               const gdb_byte *string, unsigned int length,
560               const char *encoding, int force_ellipses,
561               const struct value_print_options *options)
562 {
563   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
564             options);
565 }
566
567
568 /* See val_print for a description of the various parameters of this
569    function; they are identical.  */
570
571 void
572 ada_val_print (struct type *type, const gdb_byte *valaddr,
573                int embedded_offset, CORE_ADDR address,
574                struct ui_file *stream, int recurse,
575                const struct value *val,
576                const struct value_print_options *options)
577 {
578   volatile struct gdb_exception except;
579
580   /* XXX: this catches QUIT/ctrl-c as well.  Isn't that busted?  */
581   TRY_CATCH (except, RETURN_MASK_ALL)
582     {
583       ada_val_print_1 (type, valaddr, embedded_offset, address,
584                        stream, recurse, val, options);
585     }
586 }
587
588 /* Assuming TYPE is a simple array, print the value of this array located
589    at VALADDR + OFFSET.  See ada_val_print for a description of the various
590    parameters of this function; they are identical.  */
591
592 static void
593 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
594                      int offset, CORE_ADDR address,
595                      struct ui_file *stream, int recurse,
596                      const struct value *val,
597                      const struct value_print_options *options)
598 {
599   /* For an array of chars, print with string syntax.  */
600   if (ada_is_string_type (type)
601       && (options->format == 0 || options->format == 's'))
602     {
603       enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type));
604       struct type *elttype = TYPE_TARGET_TYPE (type);
605       unsigned int eltlen;
606       unsigned int len;
607
608       /* We know that ELTTYPE cannot possibly be null, because we found
609          that TYPE is a string-like type.  Similarly, the size of ELTTYPE
610          should also be non-null, since it's a character-like type.  */
611       gdb_assert (elttype != NULL);
612       gdb_assert (TYPE_LENGTH (elttype) != 0);
613
614       eltlen = TYPE_LENGTH (elttype);
615       len = TYPE_LENGTH (type) / eltlen;
616
617       if (options->prettyprint_arrays)
618         print_spaces_filtered (2 + 2 * recurse, stream);
619
620       /* If requested, look for the first null char and only print
621          elements up to it.  */
622       if (options->stop_print_at_null)
623         {
624           int temp_len;
625
626           /* Look for a NULL char.  */
627           for (temp_len = 0;
628                (temp_len < len
629                 && temp_len < options->print_max
630                 && char_at (valaddr + offset,
631                             temp_len, eltlen, byte_order) != 0);
632                temp_len += 1);
633           len = temp_len;
634         }
635
636       printstr (stream, elttype, valaddr + offset, len, 0, eltlen, options);
637     }
638   else
639     {
640       fprintf_filtered (stream, "(");
641       print_optional_low_bound (stream, type, options);
642       if (TYPE_FIELD_BITSIZE (type, 0) > 0)
643         val_print_packed_array_elements (type, valaddr, offset,
644                                          0, stream, recurse, val, options);
645       else
646         val_print_array_elements (type, valaddr, offset, address,
647                                   stream, recurse, val, options, 0);
648       fprintf_filtered (stream, ")");
649     }
650 }
651
652 /* See the comment on ada_val_print.  This function differs in that it
653    does not catch evaluation errors (leaving that to ada_val_print).  */
654
655 static void
656 ada_val_print_1 (struct type *type, const gdb_byte *valaddr,
657                  int offset, CORE_ADDR address,
658                  struct ui_file *stream, int recurse,
659                  const struct value *original_value,
660                  const struct value_print_options *options)
661 {
662   int i;
663   struct type *elttype;
664   int offset_aligned;
665
666   type = ada_check_typedef (type);
667
668   if (ada_is_array_descriptor_type (type)
669       || (ada_is_constrained_packed_array_type (type)
670           && TYPE_CODE (type) != TYPE_CODE_PTR))
671     {
672       struct value *mark = value_mark ();
673       struct value *val;
674
675       val = value_from_contents_and_address (type, valaddr + offset, address);
676       /* If this is a reference, coerce it now.  This helps taking care
677          of the case where ADDRESS is meaningless because original_value
678          was not an lval.  */
679       val = coerce_ref (val);
680       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)  /* array access type.  */
681         val = ada_coerce_to_simple_array_ptr (val);
682       else
683         val = ada_coerce_to_simple_array (val);
684       if (val == NULL)
685         {
686           gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
687           fprintf_filtered (stream, "0x0");
688         }
689       else
690         ada_val_print_1 (value_type (val),
691                          value_contents_for_printing (val),
692                          value_embedded_offset (val),
693                          value_address (val), stream, recurse,
694                          val, options);
695       value_free_to_mark (mark);
696       return;
697     }
698
699   offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
700   type = printable_val_type (type, valaddr + offset_aligned);
701
702   switch (TYPE_CODE (type))
703     {
704     default:
705       c_val_print (type, valaddr, offset, address, stream,
706                    recurse, original_value, options);
707       break;
708
709     case TYPE_CODE_PTR:
710       {
711         c_val_print (type, valaddr, offset, address,
712                      stream, recurse, original_value, options);
713
714         if (ada_is_tag_type (type))
715           {
716             struct value *val =
717               value_from_contents_and_address (type,
718                                                valaddr + offset_aligned,
719                                                address + offset_aligned);
720             const char *name = ada_tag_name (val);
721
722             if (name != NULL) 
723               fprintf_filtered (stream, " (%s)", name);
724           }
725         return;
726       }
727
728     case TYPE_CODE_INT:
729     case TYPE_CODE_RANGE:
730       if (ada_is_fixed_point_type (type))
731         {
732           LONGEST v = unpack_long (type, valaddr + offset_aligned);
733
734           fprintf_filtered (stream, TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g",
735                             (double) ada_fixed_to_float (type, v));
736           return;
737         }
738       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
739         {
740           struct type *target_type = TYPE_TARGET_TYPE (type);
741
742           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
743             {
744               /* Obscure case of range type that has different length from
745                  its base type.  Perform a conversion, or we will get a
746                  nonsense value.  Actually, we could use the same
747                  code regardless of lengths; I'm just avoiding a cast.  */
748               struct value *v1
749                 = value_from_contents_and_address (type, valaddr + offset, 0);
750               struct value *v = value_cast (target_type, v1);
751
752               ada_val_print_1 (target_type,
753                                value_contents_for_printing (v),
754                                value_embedded_offset (v), 0,
755                                stream, recurse + 1, v, options);
756             }
757           else
758             ada_val_print_1 (TYPE_TARGET_TYPE (type),
759                              valaddr, offset,
760                              address, stream, recurse,
761                              original_value, options);
762           return;
763         }
764       else
765         {
766           int format = (options->format ? options->format
767                         : options->output_format);
768
769           if (format)
770             {
771               struct value_print_options opts = *options;
772
773               opts.format = format;
774               val_print_scalar_formatted (type, valaddr, offset_aligned,
775                                           original_value, &opts, 0, stream);
776             }
777           else if (ada_is_system_address_type (type))
778             {
779               /* FIXME: We want to print System.Address variables using
780                  the same format as for any access type.  But for some
781                  reason GNAT encodes the System.Address type as an int,
782                  so we have to work-around this deficiency by handling
783                  System.Address values as a special case.  */
784
785               struct gdbarch *gdbarch = get_type_arch (type);
786               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
787               CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
788                                                       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 + offset_aligned, stream);
798               if (ada_is_character_type (type))
799                 {
800                   LONGEST c;
801
802                   fputs_filtered (" ", stream);
803                   c = unpack_long (type, valaddr + offset_aligned);
804                   ada_printchar (c, type, stream);
805                 }
806             }
807           return;
808         }
809
810     case TYPE_CODE_ENUM:
811       {
812         unsigned int len;
813         LONGEST val;
814
815         if (options->format)
816           {
817             val_print_scalar_formatted (type, valaddr, offset_aligned,
818                                         original_value, options, 0, stream);
819             break;
820           }
821         len = TYPE_NFIELDS (type);
822         val = unpack_long (type, valaddr + offset_aligned);
823         for (i = 0; i < len; i++)
824           {
825             QUIT;
826             if (val == TYPE_FIELD_ENUMVAL (type, i))
827               {
828                 break;
829               }
830           }
831         if (i < len)
832           {
833             const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
834
835             if (name[0] == '\'')
836               fprintf_filtered (stream, "%ld %s", (long) val, name);
837             else
838               fputs_filtered (name, stream);
839           }
840         else
841           {
842             print_longest (stream, 'd', 0, val);
843           }
844         break;
845       }
846
847     case TYPE_CODE_FLT:
848       if (options->format)
849         {
850           c_val_print (type, valaddr, offset, address, stream,
851                        recurse, original_value, options);
852           return;
853         }
854       else
855         ada_print_floating (valaddr + offset, type, stream);
856       break;
857
858     case TYPE_CODE_UNION:
859     case TYPE_CODE_STRUCT:
860       if (ada_is_bogus_array_descriptor (type))
861         {
862           fprintf_filtered (stream, "(...?)");
863           return;
864         }
865       else
866         {
867           print_record (type, valaddr, offset_aligned,
868                         stream, recurse, original_value, options);
869           return;
870         }
871
872     case TYPE_CODE_ARRAY:
873       ada_val_print_array (type, valaddr, offset_aligned,
874                            address, stream, recurse, original_value,
875                            options);
876       return;
877
878     case TYPE_CODE_REF:
879       /* For references, the debugger is expected to print the value as
880          an address if DEREF_REF is null.  But printing an address in place
881          of the object value would be confusing to an Ada programmer.
882          So, for Ada values, we print the actual dereferenced value
883          regardless.  */
884       elttype = check_typedef (TYPE_TARGET_TYPE (type));
885       
886       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
887         {
888           CORE_ADDR deref_val_int;
889           struct value *deref_val;
890
891           deref_val = coerce_ref_if_computed (original_value);
892           if (deref_val)
893             {
894               if (ada_is_tagged_type (value_type (deref_val), 1))
895                 deref_val = ada_tag_value_at_base_address (deref_val);
896
897               common_val_print (deref_val, stream, recurse + 1, options,
898                                 current_language);
899               break;
900             }
901
902           deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
903           if (deref_val_int != 0)
904             {
905               deref_val =
906                 ada_value_ind (value_from_pointer
907                                (lookup_pointer_type (elttype),
908                                 deref_val_int));
909
910               if (ada_is_tagged_type (value_type (deref_val), 1))
911                 deref_val = ada_tag_value_at_base_address (deref_val);
912
913               val_print (value_type (deref_val),
914                          value_contents_for_printing (deref_val),
915                          value_embedded_offset (deref_val),
916                          value_address (deref_val), stream, recurse + 1,
917                          deref_val, options, current_language);
918             }
919           else
920             fputs_filtered ("(null)", stream);
921         }
922       else
923         fputs_filtered ("???", stream);
924
925       break;
926     }
927   gdb_flush (stream);
928 }
929
930 static int
931 print_variant_part (struct type *type, int field_num,
932                     const gdb_byte *valaddr, int offset,
933                     struct ui_file *stream, int recurse,
934                     const struct value *val,
935                     const struct value_print_options *options,
936                     int comma_needed,
937                     struct type *outer_type, int outer_offset)
938 {
939   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
940   int which = ada_which_variant_applies (var_type, outer_type,
941                                          valaddr + outer_offset);
942
943   if (which < 0)
944     return 0;
945   else
946     return print_field_values
947       (TYPE_FIELD_TYPE (var_type, which),
948        valaddr,
949        offset + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
950        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
951        stream, recurse, val, options,
952        comma_needed, outer_type, outer_offset);
953 }
954
955 void
956 ada_value_print (struct value *val0, struct ui_file *stream,
957                  const struct value_print_options *options)
958 {
959   struct value *val = ada_to_fixed_value (val0);
960   CORE_ADDR address = value_address (val);
961   struct type *type = ada_check_typedef (value_type (val));
962   struct value_print_options opts;
963
964   /* If it is a pointer, indicate what it points to.  */
965   if (TYPE_CODE (type) == TYPE_CODE_PTR)
966     {
967       /* Hack:  don't print (char *) for char strings.  Their
968          type is indicated by the quoted string anyway.  */
969       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
970           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
971           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
972         {
973           fprintf_filtered (stream, "(");
974           type_print (type, "", stream, -1);
975           fprintf_filtered (stream, ") ");
976         }
977     }
978   else if (ada_is_array_descriptor_type (type))
979     {
980       /* We do not print the type description unless TYPE is an array
981          access type (this is encoded by the compiler as a typedef to
982          a fat pointer - hence the check against TYPE_CODE_TYPEDEF).  */
983       if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
984         {
985           fprintf_filtered (stream, "(");
986           type_print (type, "", stream, -1);
987           fprintf_filtered (stream, ") ");
988         }
989     }
990   else if (ada_is_bogus_array_descriptor (type))
991     {
992       fprintf_filtered (stream, "(");
993       type_print (type, "", stream, -1);
994       fprintf_filtered (stream, ") (...?)");
995       return;
996     }
997
998   opts = *options;
999   opts.deref_ref = 1;
1000   val_print (type, value_contents_for_printing (val),
1001              value_embedded_offset (val), address,
1002              stream, 0, val, &opts, current_language);
1003 }
1004
1005 static void
1006 print_record (struct type *type, const gdb_byte *valaddr,
1007               int offset,
1008               struct ui_file *stream, int recurse,
1009               const struct value *val,
1010               const struct value_print_options *options)
1011 {
1012   type = ada_check_typedef (type);
1013
1014   fprintf_filtered (stream, "(");
1015
1016   if (print_field_values (type, valaddr, offset,
1017                           stream, recurse, val, options,
1018                           0, type, offset) != 0 && options->pretty)
1019     {
1020       fprintf_filtered (stream, "\n");
1021       print_spaces_filtered (2 * recurse, stream);
1022     }
1023
1024   fprintf_filtered (stream, ")");
1025 }
1026
1027 /* Print out fields of value at VALADDR + OFFSET having structure type TYPE.
1028
1029    TYPE, VALADDR, OFFSET, STREAM, RECURSE, and OPTIONS have the same
1030    meanings as in ada_print_value and ada_val_print.
1031
1032    OUTER_TYPE and OUTER_OFFSET give type and address of enclosing
1033    record (used to get discriminant values when printing variant
1034    parts).
1035
1036    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1037    level, so that a comma is needed before any field printed by this
1038    call.
1039
1040    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1041
1042 static int
1043 print_field_values (struct type *type, const gdb_byte *valaddr,
1044                     int offset, struct ui_file *stream, int recurse,
1045                     const struct value *val,
1046                     const struct value_print_options *options,
1047                     int comma_needed,
1048                     struct type *outer_type, int outer_offset)
1049 {
1050   int i, len;
1051
1052   len = TYPE_NFIELDS (type);
1053
1054   for (i = 0; i < len; i += 1)
1055     {
1056       if (ada_is_ignored_field (type, i))
1057         continue;
1058
1059       if (ada_is_wrapper_field (type, i))
1060         {
1061           comma_needed =
1062             print_field_values (TYPE_FIELD_TYPE (type, i),
1063                                 valaddr,
1064                                 (offset
1065                                  + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
1066                                 stream, recurse, val, options,
1067                                 comma_needed, type, offset);
1068           continue;
1069         }
1070       else if (ada_is_variant_part (type, i))
1071         {
1072           comma_needed =
1073             print_variant_part (type, i, valaddr,
1074                                 offset, stream, recurse, val,
1075                                 options, comma_needed,
1076                                 outer_type, outer_offset);
1077           continue;
1078         }
1079
1080       if (comma_needed)
1081         fprintf_filtered (stream, ", ");
1082       comma_needed = 1;
1083
1084       if (options->pretty)
1085         {
1086           fprintf_filtered (stream, "\n");
1087           print_spaces_filtered (2 + 2 * recurse, stream);
1088         }
1089       else
1090         {
1091           wrap_here (n_spaces (2 + 2 * recurse));
1092         }
1093       if (options->inspect_it)
1094         {
1095           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1096             fputs_filtered ("\"( ptr \"", stream);
1097           else
1098             fputs_filtered ("\"( nodef \"", stream);
1099           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1100                                    language_cplus, DMGL_NO_OPTS);
1101           fputs_filtered ("\" \"", stream);
1102           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1103                                    language_cplus, DMGL_NO_OPTS);
1104           fputs_filtered ("\") \"", stream);
1105         }
1106       else
1107         {
1108           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1109           fprintf_filtered (stream, "%.*s",
1110                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1111                             TYPE_FIELD_NAME (type, i));
1112           annotate_field_name_end ();
1113           fputs_filtered (" => ", stream);
1114           annotate_field_value ();
1115         }
1116
1117       if (TYPE_FIELD_PACKED (type, i))
1118         {
1119           struct value *v;
1120
1121           /* Bitfields require special handling, especially due to byte
1122              order problems.  */
1123           if (HAVE_CPLUS_STRUCT (type) && TYPE_FIELD_IGNORE (type, i))
1124             {
1125               fputs_filtered (_("<optimized out or zero length>"), stream);
1126             }
1127           else
1128             {
1129               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1130               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1131               struct value_print_options opts;
1132
1133               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1134               v = ada_value_primitive_packed_val
1135                     (NULL, valaddr,
1136                      offset + bit_pos / HOST_CHAR_BIT,
1137                      bit_pos % HOST_CHAR_BIT,
1138                      bit_size, TYPE_FIELD_TYPE (type, i));
1139               opts = *options;
1140               opts.deref_ref = 0;
1141               val_print (TYPE_FIELD_TYPE (type, i),
1142                          value_contents_for_printing (v),
1143                          value_embedded_offset (v), 0,
1144                          stream, recurse + 1, v,
1145                          &opts, current_language);
1146             }
1147         }
1148       else
1149         {
1150           struct value_print_options opts = *options;
1151
1152           opts.deref_ref = 0;
1153           ada_val_print (TYPE_FIELD_TYPE (type, i),
1154                          valaddr,
1155                          (offset
1156                           + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT),
1157                          0, stream, recurse + 1, val, &opts);
1158         }
1159       annotate_field_end ();
1160     }
1161
1162   return comma_needed;
1163 }