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