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