* defs.h (strlen_paddr, paddr, paddr_nz): Remove.
[external/binutils.git] / gdb / ada-valprint.c
1 /* Support for printing Ada values for GDB, the GNU debugger.
2
3    Copyright (C) 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1997, 2001, 2002,
4    2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5
6    This file is part of GDB.
7
8    This program is free software; you can redistribute it and/or modify
9    it under the terms of the GNU General Public License as published by
10    the Free Software Foundation; either version 3 of the License, or
11    (at your option) any later version.
12
13    This program is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16    GNU General Public License for more details.
17
18    You should have received a copy of the GNU General Public License
19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
20
21 #include <ctype.h>
22 #include "defs.h"
23 #include "gdb_string.h"
24 #include "symtab.h"
25 #include "gdbtypes.h"
26 #include "expression.h"
27 #include "value.h"
28 #include "demangle.h"
29 #include "valprint.h"
30 #include "language.h"
31 #include "annotate.h"
32 #include "ada-lang.h"
33 #include "c-lang.h"
34 #include "infcall.h"
35 #include "exceptions.h"
36 #include "objfiles.h"
37
38 /* Encapsulates arguments to ada_val_print.  */
39 struct ada_val_print_args
40 {
41   struct type *type;
42   const gdb_byte *valaddr0;
43   int embedded_offset;
44   CORE_ADDR address;
45   struct ui_file *stream;
46   int recurse;
47   const struct value_print_options *options;
48 };
49
50 static void print_record (struct type *, const gdb_byte *, struct ui_file *,
51                           int, const struct value_print_options *);
52
53 static int print_field_values (struct type *, const gdb_byte *,
54                                struct ui_file *, int,
55                                const struct value_print_options *,
56                                int, struct type *,
57                                const gdb_byte *);
58
59 static void adjust_type_signedness (struct type *);
60
61 static int ada_val_print_stub (void *args0);
62
63 static int ada_val_print_1 (struct type *, const gdb_byte *, int, CORE_ADDR,
64                             struct ui_file *, int,
65                             const struct value_print_options *);
66 \f
67
68 /* Make TYPE unsigned if its range of values includes no negatives.  */
69 static void
70 adjust_type_signedness (struct type *type)
71 {
72   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
73       && TYPE_LOW_BOUND (type) >= 0)
74     TYPE_UNSIGNED (type) = 1;
75 }
76
77 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
78    if non-standard (i.e., other than 1 for numbers, other than lower bound
79    of index type for enumerated type).  Returns 1 if something printed,
80    otherwise 0.  */
81
82 static int
83 print_optional_low_bound (struct ui_file *stream, struct type *type,
84                           const struct value_print_options *options)
85 {
86   struct type *index_type;
87   long low_bound;
88   long high_bound;
89
90   if (options->print_array_indexes)
91     return 0;
92
93   if (!get_array_bounds (type, &low_bound, &high_bound))
94     return 0;
95
96   /* If this is an empty array, then don't print the lower bound.
97      That would be confusing, because we would print the lower bound,
98      followed by... nothing!  */
99   if (low_bound > high_bound)
100     return 0;
101
102   index_type = TYPE_INDEX_TYPE (type);
103
104   if (TYPE_CODE (index_type) == TYPE_CODE_RANGE)
105     {
106       /* We need to know what the base type is, in order to do the
107          appropriate check below.  Otherwise, if this is a subrange
108          of an enumerated type, where the underlying value of the
109          first element is typically 0, we might test the low bound
110          against the wrong value.  */
111       index_type = TYPE_TARGET_TYPE (index_type);
112     }
113
114   switch (TYPE_CODE (index_type))
115     {
116     case TYPE_CODE_BOOL:
117       if (low_bound == 0)
118         return 0;
119       break;
120     case TYPE_CODE_ENUM:
121       if (low_bound == TYPE_FIELD_BITPOS (index_type, 0))
122         return 0;
123       break;
124     case TYPE_CODE_UNDEF:
125       index_type = NULL;
126       /* FALL THROUGH */
127     default:
128       if (low_bound == 1)
129         return 0;
130       break;
131     }
132
133   ada_print_scalar (index_type, (LONGEST) low_bound, stream);
134   fprintf_filtered (stream, " => ");
135   return 1;
136 }
137
138 /*  Version of val_print_array_elements for GNAT-style packed arrays.
139     Prints elements of packed array of type TYPE at bit offset
140     BITOFFSET from VALADDR on STREAM.  Formats according to OPTIONS and
141     separates with commas.  RECURSE is the recursion (nesting) level.
142     TYPE must have been decoded (as by ada_coerce_to_simple_array).  */
143
144 static void
145 val_print_packed_array_elements (struct type *type, const gdb_byte *valaddr,
146                                  int bitoffset, struct ui_file *stream,
147                                  int recurse,
148                                  const struct value_print_options *options)
149 {
150   unsigned int i;
151   unsigned int things_printed = 0;
152   unsigned len;
153   struct type *elttype, *index_type;
154   unsigned eltlen;
155   unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
156   struct value *mark = value_mark ();
157   LONGEST low = 0;
158
159   elttype = TYPE_TARGET_TYPE (type);
160   eltlen = TYPE_LENGTH (check_typedef (elttype));
161   index_type = TYPE_INDEX_TYPE (type);
162
163   {
164     LONGEST high;
165     if (get_discrete_bounds (index_type, &low, &high) < 0)
166       len = 1;
167     else
168       len = high - low + 1;
169   }
170
171   i = 0;
172   annotate_array_section_begin (i, elttype);
173
174   while (i < len && things_printed < options->print_max)
175     {
176       struct value *v0, *v1;
177       int i0;
178
179       if (i != 0)
180         {
181           if (options->prettyprint_arrays)
182             {
183               fprintf_filtered (stream, ",\n");
184               print_spaces_filtered (2 + 2 * recurse, stream);
185             }
186           else
187             {
188               fprintf_filtered (stream, ", ");
189             }
190         }
191       wrap_here (n_spaces (2 + 2 * recurse));
192       maybe_print_array_index (index_type, i + low, stream, options);
193
194       i0 = i;
195       v0 = ada_value_primitive_packed_val (NULL, valaddr,
196                                            (i0 * bitsize) / HOST_CHAR_BIT,
197                                            (i0 * bitsize) % HOST_CHAR_BIT,
198                                            bitsize, elttype);
199       while (1)
200         {
201           i += 1;
202           if (i >= len)
203             break;
204           v1 = ada_value_primitive_packed_val (NULL, valaddr,
205                                                (i * bitsize) / HOST_CHAR_BIT,
206                                                (i * bitsize) % HOST_CHAR_BIT,
207                                                bitsize, elttype);
208           if (memcmp (value_contents (v0), value_contents (v1), eltlen) != 0)
209             break;
210         }
211
212       if (i - i0 > options->repeat_count_threshold)
213         {
214           struct value_print_options opts = *options;
215           opts.deref_ref = 0;
216           val_print (elttype, value_contents (v0), 0, 0, stream,
217                      recurse + 1, &opts, current_language);
218           annotate_elt_rep (i - i0);
219           fprintf_filtered (stream, _(" <repeats %u times>"), i - i0);
220           annotate_elt_rep_end ();
221
222         }
223       else
224         {
225           int j;
226           struct value_print_options opts = *options;
227           opts.deref_ref = 0;
228           for (j = i0; j < i; j += 1)
229             {
230               if (j > i0)
231                 {
232                   if (options->prettyprint_arrays)
233                     {
234                       fprintf_filtered (stream, ",\n");
235                       print_spaces_filtered (2 + 2 * recurse, stream);
236                     }
237                   else
238                     {
239                       fprintf_filtered (stream, ", ");
240                     }
241                   wrap_here (n_spaces (2 + 2 * recurse));
242                   maybe_print_array_index (index_type, j + low,
243                                            stream, options);
244                 }
245               val_print (elttype, value_contents (v0), 0, 0, stream,
246                          recurse + 1, &opts, current_language);
247               annotate_elt ();
248             }
249         }
250       things_printed += i - i0;
251     }
252   annotate_array_section_end ();
253   if (i < len)
254     {
255       fprintf_filtered (stream, "...");
256     }
257
258   value_free_to_mark (mark);
259 }
260
261 static struct type *
262 printable_val_type (struct type *type, const gdb_byte *valaddr)
263 {
264   return ada_to_fixed_type (ada_aligned_type (type), valaddr, 0, NULL, 1);
265 }
266
267 /* Print the character C on STREAM as part of the contents of a literal
268    string whose delimiter is QUOTER.  TYPE_LEN is the length in bytes
269    (1 or 2) of the character.  */
270
271 void
272 ada_emit_char (int c, struct type *type, struct ui_file *stream,
273                int quoter, int type_len)
274 {
275   if (type_len != 2)
276     type_len = 1;
277
278   c &= (1 << (type_len * TARGET_CHAR_BIT)) - 1;
279
280   if (isascii (c) && isprint (c))
281     {
282       if (c == quoter && c == '"')
283         fprintf_filtered (stream, "\"\"");
284       else
285         fprintf_filtered (stream, "%c", c);
286     }
287   else
288     fprintf_filtered (stream, "[\"%0*x\"]", type_len * 2, c);
289 }
290
291 /* Character #I of STRING, given that TYPE_LEN is the size in bytes (1
292    or 2) of a character.  */
293
294 static int
295 char_at (const gdb_byte *string, int i, int type_len)
296 {
297   if (type_len == 1)
298     return string[i];
299   else
300     return (int) extract_unsigned_integer (string + 2 * i, 2);
301 }
302
303 /* Wrapper around memcpy to make it legal argument to ui_file_put */
304 static void
305 ui_memcpy (void *dest, const char *buffer, long len)
306 {
307   memcpy (dest, buffer, (size_t) len);
308   ((char *) dest)[len] = '\0';
309 }
310
311 /* Print a floating-point value of type TYPE, pointed to in GDB by
312    VALADDR, on STREAM.  Use Ada formatting conventions: there must be
313    a decimal point, and at least one digit before and after the
314    point.  We use GNAT format for NaNs and infinities.  */
315 static void
316 ada_print_floating (const gdb_byte *valaddr, struct type *type,
317                     struct ui_file *stream)
318 {
319   char buffer[64];
320   char *s, *result;
321   int len;
322   struct ui_file *tmp_stream = mem_fileopen ();
323   struct cleanup *cleanups = make_cleanup_ui_file_delete (tmp_stream);
324
325   print_floating (valaddr, type, tmp_stream);
326   ui_file_put (tmp_stream, ui_memcpy, buffer);
327   do_cleanups (cleanups);
328
329   result = buffer;
330   len = strlen (result);
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, '\'', 1);
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_BITPOS (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 ((unsigned 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
461    FORCE_ELLIPSES.   TYPE_LEN is the length (1 or 2) of the character type.
462  */
463
464 static void
465 printstr (struct ui_file *stream, struct type *elttype, const gdb_byte *string,
466           unsigned int length, int force_ellipses, int type_len,
467           const struct value_print_options *options)
468 {
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) == char_at (string, i,
500                                                              type_len))
501         {
502           rep1 += 1;
503           reps += 1;
504         }
505
506       if (reps > options->repeat_count_threshold)
507         {
508           if (in_quotes)
509             {
510               if (options->inspect_it)
511                 fputs_filtered ("\\\", ", stream);
512               else
513                 fputs_filtered ("\", ", stream);
514               in_quotes = 0;
515             }
516           fputs_filtered ("'", stream);
517           ada_emit_char (char_at (string, i, type_len), elttype, stream, '\'',
518                          type_len);
519           fputs_filtered ("'", stream);
520           fprintf_filtered (stream, _(" <repeats %u times>"), reps);
521           i = rep1 - 1;
522           things_printed += options->repeat_count_threshold;
523           need_comma = 1;
524         }
525       else
526         {
527           if (!in_quotes)
528             {
529               if (options->inspect_it)
530                 fputs_filtered ("\\\"", stream);
531               else
532                 fputs_filtered ("\"", stream);
533               in_quotes = 1;
534             }
535           ada_emit_char (char_at (string, i, type_len), elttype, stream, '"',
536                          type_len);
537           things_printed += 1;
538         }
539     }
540
541   /* Terminate the quotes if necessary.  */
542   if (in_quotes)
543     {
544       if (options->inspect_it)
545         fputs_filtered ("\\\"", stream);
546       else
547         fputs_filtered ("\"", stream);
548     }
549
550   if (force_ellipses || i < length)
551     fputs_filtered ("...", stream);
552 }
553
554 void
555 ada_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
556               unsigned int length, int force_ellipses,
557               const struct value_print_options *options)
558 {
559   printstr (stream, type, string, length, force_ellipses, TYPE_LENGTH (type),
560             options);
561 }
562
563
564 /* Print data of type TYPE located at VALADDR (within GDB), which came from
565    the inferior at address ADDRESS, onto stdio stream STREAM according to
566    OPTIONS.  The data at VALADDR is in target byte order.
567
568    If the data is printed as a string, returns the number of string characters
569    printed.
570
571    RECURSE indicates the amount of indentation to supply before
572    continuation lines; this amount is roughly twice the value of RECURSE.  */
573
574 int
575 ada_val_print (struct type *type, const gdb_byte *valaddr0,
576                int embedded_offset, CORE_ADDR address,
577                struct ui_file *stream, int recurse,
578                const struct value_print_options *options)
579 {
580   struct ada_val_print_args args;
581   args.type = type;
582   args.valaddr0 = valaddr0;
583   args.embedded_offset = embedded_offset;
584   args.address = address;
585   args.stream = stream;
586   args.recurse = recurse;
587   args.options = options;
588
589   return catch_errors (ada_val_print_stub, &args, NULL, RETURN_MASK_ALL);
590 }
591
592 /* Helper for ada_val_print; used as argument to catch_errors to
593    unmarshal the arguments to ada_val_print_1, which does the work.  */
594 static int
595 ada_val_print_stub (void *args0)
596 {
597   struct ada_val_print_args *argsp = (struct ada_val_print_args *) args0;
598   return ada_val_print_1 (argsp->type, argsp->valaddr0,
599                           argsp->embedded_offset, argsp->address,
600                           argsp->stream, argsp->recurse, argsp->options);
601 }
602
603 /* Assuming TYPE is a simple array, print the value of this array located
604    at VALADDR.  See ada_val_print for a description of the various
605    parameters of this function; they are identical.  The semantics
606    of the return value is also identical to ada_val_print.  */
607
608 static int
609 ada_val_print_array (struct type *type, const gdb_byte *valaddr,
610                      CORE_ADDR address, struct ui_file *stream, int recurse,
611                      const struct value_print_options *options)
612 {
613   struct type *elttype = TYPE_TARGET_TYPE (type);
614   unsigned int eltlen;
615   unsigned int len;
616   int result = 0;
617
618   if (elttype == NULL)
619     eltlen = 0;
620   else
621     eltlen = TYPE_LENGTH (elttype);
622   if (eltlen == 0)
623     len = 0;
624   else
625     len = TYPE_LENGTH (type) / eltlen;
626
627   /* For an array of chars, print with string syntax.  */
628   if (ada_is_string_type (type)
629       && (options->format == 0 || options->format == 's'))
630     {
631       if (options->prettyprint_arrays)
632         print_spaces_filtered (2 + 2 * recurse, stream);
633
634       /* If requested, look for the first null char and only print
635          elements up to it.  */
636       if (options->stop_print_at_null)
637         {
638           int temp_len;
639
640           /* Look for a NULL char.  */
641           for (temp_len = 0;
642                (temp_len < len
643                 && temp_len < options->print_max
644                 && char_at (valaddr, temp_len, eltlen) != 0);
645                temp_len += 1);
646           len = temp_len;
647         }
648
649       printstr (stream, elttype, valaddr, len, 0, eltlen, options);
650       result = len;
651     }
652   else
653     {
654       fprintf_filtered (stream, "(");
655       print_optional_low_bound (stream, type, options);
656       if (TYPE_FIELD_BITSIZE (type, 0) > 0)
657         val_print_packed_array_elements (type, valaddr, 0, stream,
658                                          recurse, options);
659       else
660         val_print_array_elements (type, valaddr, address, stream,
661                                   recurse, options, 0);
662       fprintf_filtered (stream, ")");
663     }
664
665   return result;
666 }
667
668 /* See the comment on ada_val_print.  This function differs in that it
669    does not catch evaluation errors (leaving that to ada_val_print).  */
670
671 static int
672 ada_val_print_1 (struct type *type, const gdb_byte *valaddr0,
673                  int embedded_offset, CORE_ADDR address,
674                  struct ui_file *stream, int recurse,
675                  const struct value_print_options *options)
676 {
677   unsigned int len;
678   int i;
679   struct type *elttype;
680   unsigned int eltlen;
681   LONGEST val;
682   const gdb_byte *valaddr = valaddr0 + embedded_offset;
683
684   type = ada_check_typedef (type);
685
686   if (ada_is_array_descriptor_type (type) || ada_is_packed_array_type (type))
687     {
688       int retn;
689       struct value *mark = value_mark ();
690       struct value *val;
691       val = value_from_contents_and_address (type, valaddr, address);
692       val = ada_coerce_to_simple_array_ptr (val);
693       if (val == NULL)
694         {
695           fprintf_filtered (stream, "(null)");
696           retn = 0;
697         }
698       else
699         retn = ada_val_print_1 (value_type (val), value_contents (val), 0,
700                                 value_address (val), stream, recurse, options);
701       value_free_to_mark (mark);
702       return retn;
703     }
704
705   valaddr = ada_aligned_value_addr (type, valaddr);
706   embedded_offset -= valaddr - valaddr0 - embedded_offset;
707   type = printable_val_type (type, valaddr);
708
709   switch (TYPE_CODE (type))
710     {
711     default:
712       return c_val_print (type, valaddr0, embedded_offset, address, stream,
713                           recurse, options);
714
715     case TYPE_CODE_PTR:
716       {
717         int ret = c_val_print (type, valaddr0, embedded_offset, address, 
718                                stream, recurse, options);
719         if (ada_is_tag_type (type))
720           {
721             struct value *val = 
722               value_from_contents_and_address (type, valaddr, address);
723             const char *name = ada_tag_name (val);
724             if (name != NULL) 
725               fprintf_filtered (stream, " (%s)", name);
726             return 0;
727         }
728         return ret;
729       }
730
731     case TYPE_CODE_INT:
732     case TYPE_CODE_RANGE:
733       if (ada_is_fixed_point_type (type))
734         {
735           LONGEST v = unpack_long (type, valaddr);
736           int len = TYPE_LENGTH (type);
737
738           fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
739                             (double) ada_fixed_to_float (type, v));
740           return 0;
741         }
742       else if (ada_is_vax_floating_type (type))
743         {
744           struct value *val =
745             value_from_contents_and_address (type, valaddr, address);
746           struct value *func = ada_vax_float_print_function (type);
747           if (func != 0)
748             {
749               struct gdbarch *gdbarch = get_type_arch (type);
750               CORE_ADDR addr;
751               addr = value_as_address (call_function_by_hand (func, 1, &val));
752               val_print_string (builtin_type (gdbarch)->builtin_true_char,
753                                 addr, -1, stream, options);
754               return 0;
755             }
756           /* No special printing function.  Do as best we can.  */
757         }
758       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
759         {
760           struct type *target_type = TYPE_TARGET_TYPE (type);
761           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
762             {
763               /* Obscure case of range type that has different length from
764                  its base type.  Perform a conversion, or we will get a
765                  nonsense value.  Actually, we could use the same
766                  code regardless of lengths; I'm just avoiding a cast.  */
767               struct value *v = value_cast (target_type,
768                                             value_from_contents_and_address
769                                             (type, valaddr, 0));
770               return ada_val_print_1 (target_type, value_contents (v), 0, 0,
771                                       stream, recurse + 1, options);
772             }
773           else
774             return ada_val_print_1 (TYPE_TARGET_TYPE (type),
775                                     valaddr0, embedded_offset,
776                                     address, stream, recurse, options);
777         }
778       else
779         {
780           int format = (options->format ? options->format
781                         : options->output_format);
782           if (format)
783             {
784               struct value_print_options opts = *options;
785               opts.format = format;
786               print_scalar_formatted (valaddr, type, &opts, 0, stream);
787             }
788           else if (ada_is_system_address_type (type))
789             {
790               /* FIXME: We want to print System.Address variables using
791                  the same format as for any access type.  But for some
792                  reason GNAT encodes the System.Address type as an int,
793                  so we have to work-around this deficiency by handling
794                  System.Address values as a special case.  */
795
796               struct gdbarch *gdbarch = get_type_arch (type);
797               struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
798               CORE_ADDR addr = extract_typed_address (valaddr, ptr_type);
799
800               fprintf_filtered (stream, "(");
801               type_print (type, "", stream, -1);
802               fprintf_filtered (stream, ") ");
803               fputs_filtered (paddress (gdbarch, addr), stream);
804             }
805           else
806             {
807               val_print_type_code_int (type, valaddr, stream);
808               if (ada_is_character_type (type))
809                 {
810                   fputs_filtered (" ", stream);
811                   ada_printchar ((unsigned char) unpack_long (type, valaddr),
812                                  type, stream);
813                 }
814             }
815           return 0;
816         }
817
818     case TYPE_CODE_ENUM:
819       if (options->format)
820         {
821           print_scalar_formatted (valaddr, type, options, 0, stream);
822           break;
823         }
824       len = TYPE_NFIELDS (type);
825       val = unpack_long (type, valaddr);
826       for (i = 0; i < len; i++)
827         {
828           QUIT;
829           if (val == TYPE_FIELD_BITPOS (type, i))
830             {
831               break;
832             }
833         }
834       if (i < len)
835         {
836           const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
837           if (name[0] == '\'')
838             fprintf_filtered (stream, "%ld %s", (long) val, name);
839           else
840             fputs_filtered (name, stream);
841         }
842       else
843         {
844           print_longest (stream, 'd', 0, val);
845         }
846       break;
847
848     case TYPE_CODE_FLAGS:
849       if (options->format)
850         print_scalar_formatted (valaddr, type, options, 0, stream);
851       else
852         val_print_type_code_flags (type, valaddr, stream);
853       break;
854
855     case TYPE_CODE_FLT:
856       if (options->format)
857         return c_val_print (type, valaddr0, embedded_offset, address, stream,
858                             recurse, options);
859       else
860         ada_print_floating (valaddr0 + embedded_offset, type, stream);
861       break;
862
863     case TYPE_CODE_UNION:
864     case TYPE_CODE_STRUCT:
865       if (ada_is_bogus_array_descriptor (type))
866         {
867           fprintf_filtered (stream, "(...?)");
868           return 0;
869         }
870       else
871         {
872           print_record (type, valaddr, stream, recurse, options);
873           return 0;
874         }
875
876     case TYPE_CODE_ARRAY:
877       return ada_val_print_array (type, valaddr, address, stream,
878                                   recurse, options);
879
880     case TYPE_CODE_REF:
881       /* For references, the debugger is expected to print the value as
882          an address if DEREF_REF is null.  But printing an address in place
883          of the object value would be confusing to an Ada programmer.
884          So, for Ada values, we print the actual dereferenced value
885          regardless.  */
886       elttype = check_typedef (TYPE_TARGET_TYPE (type));
887       
888       if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
889         {
890           LONGEST deref_val_int = (LONGEST) unpack_pointer (type, valaddr);
891           if (deref_val_int != 0)
892             {
893               struct value *deref_val =
894                 ada_value_ind (value_from_longest
895                                (lookup_pointer_type (elttype),
896                                 deref_val_int));
897               val_print (value_type (deref_val),
898                          value_contents (deref_val), 0,
899                          value_address (deref_val), stream, recurse + 1,
900                          options, current_language);
901             }
902           else
903             fputs_filtered ("(null)", stream);
904         }
905       else
906         fputs_filtered ("???", stream);
907
908       break;
909     }
910   gdb_flush (stream);
911   return 0;
912 }
913
914 static int
915 print_variant_part (struct type *type, int field_num, const gdb_byte *valaddr,
916                     struct ui_file *stream, int recurse,
917                     const struct value_print_options *options, int comma_needed,
918                     struct type *outer_type, const gdb_byte *outer_valaddr)
919 {
920   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
921   int which = ada_which_variant_applies (var_type, outer_type, outer_valaddr);
922
923   if (which < 0)
924     return 0;
925   else
926     return print_field_values
927       (TYPE_FIELD_TYPE (var_type, which),
928        valaddr + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
929        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
930        stream, recurse, options,
931        comma_needed, outer_type, outer_valaddr);
932 }
933
934 int
935 ada_value_print (struct value *val0, struct ui_file *stream,
936                  const struct value_print_options *options)
937 {
938   const gdb_byte *valaddr = value_contents (val0);
939   CORE_ADDR address = value_address (val0);
940   struct type *type =
941     ada_to_fixed_type (value_type (val0), valaddr, address, NULL, 1);
942   struct value *val =
943     value_from_contents_and_address (type, valaddr, address);
944   struct value_print_options opts;
945
946   /* If it is a pointer, indicate what it points to.  */
947   if (TYPE_CODE (type) == TYPE_CODE_PTR)
948     {
949       /* Hack:  don't print (char *) for char strings.  Their
950          type is indicated by the quoted string anyway.  */
951       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
952           || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT 
953           || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
954         {
955           fprintf_filtered (stream, "(");
956           type_print (type, "", stream, -1);
957           fprintf_filtered (stream, ") ");
958         }
959     }
960   else if (ada_is_array_descriptor_type (type))
961     {
962       fprintf_filtered (stream, "(");
963       type_print (type, "", stream, -1);
964       fprintf_filtered (stream, ") ");
965     }
966   else if (ada_is_bogus_array_descriptor (type))
967     {
968       fprintf_filtered (stream, "(");
969       type_print (type, "", stream, -1);
970       fprintf_filtered (stream, ") (...?)");
971       return 0;
972     }
973
974   opts = *options;
975   opts.deref_ref = 1;
976   return (val_print (type, value_contents (val), 0, address,
977                      stream, 0, &opts, current_language));
978 }
979
980 static void
981 print_record (struct type *type, const gdb_byte *valaddr,
982               struct ui_file *stream, int recurse,
983               const struct value_print_options *options)
984 {
985   type = ada_check_typedef (type);
986
987   fprintf_filtered (stream, "(");
988
989   if (print_field_values (type, valaddr, stream, recurse, options,
990                           0, type, valaddr) != 0 && options->pretty)
991     {
992       fprintf_filtered (stream, "\n");
993       print_spaces_filtered (2 * recurse, stream);
994     }
995
996   fprintf_filtered (stream, ")");
997 }
998
999 /* Print out fields of value at VALADDR having structure type TYPE.
1000
1001    TYPE, VALADDR, STREAM, RECURSE, and OPTIONS have the
1002    same meanings as in ada_print_value and ada_val_print.
1003
1004    OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
1005    (used to get discriminant values when printing variant parts).
1006
1007    COMMA_NEEDED is 1 if fields have been printed at the current recursion
1008    level, so that a comma is needed before any field printed by this
1009    call.
1010
1011    Returns 1 if COMMA_NEEDED or any fields were printed.  */
1012
1013 static int
1014 print_field_values (struct type *type, const gdb_byte *valaddr,
1015                     struct ui_file *stream, int recurse,
1016                     const struct value_print_options *options,
1017                     int comma_needed,
1018                     struct type *outer_type, const gdb_byte *outer_valaddr)
1019 {
1020   int i, len;
1021
1022   len = TYPE_NFIELDS (type);
1023
1024   for (i = 0; i < len; i += 1)
1025     {
1026       if (ada_is_ignored_field (type, i))
1027         continue;
1028
1029       if (ada_is_wrapper_field (type, i))
1030         {
1031           comma_needed =
1032             print_field_values (TYPE_FIELD_TYPE (type, i),
1033                                 valaddr
1034                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1035                                 stream, recurse, options,
1036                                 comma_needed, type, valaddr);
1037           continue;
1038         }
1039       else if (ada_is_variant_part (type, i))
1040         {
1041           comma_needed =
1042             print_variant_part (type, i, valaddr,
1043                                 stream, recurse, options, comma_needed,
1044                                 outer_type, outer_valaddr);
1045           continue;
1046         }
1047
1048       if (comma_needed)
1049         fprintf_filtered (stream, ", ");
1050       comma_needed = 1;
1051
1052       if (options->pretty)
1053         {
1054           fprintf_filtered (stream, "\n");
1055           print_spaces_filtered (2 + 2 * recurse, stream);
1056         }
1057       else
1058         {
1059           wrap_here (n_spaces (2 + 2 * recurse));
1060         }
1061       if (options->inspect_it)
1062         {
1063           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1064             fputs_filtered ("\"( ptr \"", stream);
1065           else
1066             fputs_filtered ("\"( nodef \"", stream);
1067           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1068                                    language_cplus, DMGL_NO_OPTS);
1069           fputs_filtered ("\" \"", stream);
1070           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1071                                    language_cplus, DMGL_NO_OPTS);
1072           fputs_filtered ("\") \"", stream);
1073         }
1074       else
1075         {
1076           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1077           fprintf_filtered (stream, "%.*s",
1078                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1079                             TYPE_FIELD_NAME (type, i));
1080           annotate_field_name_end ();
1081           fputs_filtered (" => ", stream);
1082           annotate_field_value ();
1083         }
1084
1085       if (TYPE_FIELD_PACKED (type, i))
1086         {
1087           struct value *v;
1088
1089           /* Bitfields require special handling, especially due to byte
1090              order problems.  */
1091           if (TYPE_CPLUS_SPECIFIC (type) != NULL
1092               && TYPE_FIELD_IGNORE (type, i))
1093             {
1094               fputs_filtered (_("<optimized out or zero length>"), stream);
1095             }
1096           else
1097             {
1098               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1099               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1100               struct value_print_options opts;
1101
1102               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1103               v = ada_value_primitive_packed_val (NULL, valaddr,
1104                                                   bit_pos / HOST_CHAR_BIT,
1105                                                   bit_pos % HOST_CHAR_BIT,
1106                                                   bit_size,
1107                                                   TYPE_FIELD_TYPE (type, i));
1108               opts = *options;
1109               opts.deref_ref = 0;
1110               val_print (TYPE_FIELD_TYPE (type, i), value_contents (v), 0, 0,
1111                          stream, recurse + 1, &opts, current_language);
1112             }
1113         }
1114       else
1115         {
1116           struct value_print_options opts = *options;
1117           opts.deref_ref = 0;
1118           ada_val_print (TYPE_FIELD_TYPE (type, i),
1119                          valaddr + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1120                          0, 0, stream, recurse + 1, &opts);
1121         }
1122       annotate_field_end ();
1123     }
1124
1125   return comma_needed;
1126 }