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