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