Add base ada language files
[platform/upstream/binutils.git] / gdb / ada-valprint.c
1 /* Support for printing Ada values for GDB, the GNU debugger.  
2    Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1997, 2001
3              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 2 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, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
20
21 #include <ctype.h>
22 #include "defs.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
34 /* Encapsulates arguments to ada_val_print. */
35 struct ada_val_print_args {
36   struct type* type;
37   char* valaddr0;
38   int embedded_offset;
39   CORE_ADDR address;
40   struct ui_file *stream;
41   int format;
42   int deref_ref;
43   int recurse;
44   enum val_prettyprint pretty;
45 };
46
47 extern int inspect_it;
48 extern unsigned int repeat_count_threshold;
49
50 static void print_record (struct type*, char*, struct ui_file*, int,
51                           int, enum val_prettyprint);
52
53 static int print_field_values (struct type*, char*, struct ui_file*, 
54                                int, int, enum val_prettyprint,
55                                int, struct type*, char*);
56
57 static int print_variant_part (struct type*, int, char*, 
58                                struct ui_file*, int, int, enum val_prettyprint,
59                                int, struct type*, char*);
60
61 static void
62 val_print_packed_array_elements (struct type*, char *valaddr, int,
63                                  struct ui_file*, int, int, 
64                                  enum val_prettyprint);
65
66 static void adjust_type_signedness (struct type*);
67
68 static int ada_val_print_stub (PTR args0);
69
70 static int
71 ada_val_print_1 (struct type*, char*, int, CORE_ADDR, struct ui_file*,
72                  int, int, int, enum val_prettyprint);
73 \f
74
75 /* Make TYPE unsigned if its range of values includes no negatives. */
76 static void 
77 adjust_type_signedness (type)
78      struct type* type;
79 {
80   if (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE 
81       && TYPE_LOW_BOUND (type) >= 0)
82     TYPE_FLAGS (type) |= TYPE_FLAG_UNSIGNED;
83 }       
84
85 /* Assuming TYPE is a simple array type, prints its lower bound on STREAM,
86    if non-standard (i.e., other than 1 for numbers, other than lower bound
87    of index type for enumerated type). Returns 1 if something printed, 
88    otherwise 0. */
89
90 static int 
91 print_optional_low_bound (stream, type)
92      struct ui_file *stream;
93      struct type *type;
94 {
95   struct type *index_type;
96   long low_bound;
97
98   index_type = TYPE_INDEX_TYPE (type);
99   low_bound = 0;
100
101   if (index_type == NULL)
102     return 0;
103   if (TYPE_CODE (index_type) == TYPE_CODE_RANGE) 
104     {
105       low_bound = TYPE_LOW_BOUND (index_type);
106       index_type = TYPE_TARGET_TYPE (index_type);
107     }
108   else
109     return 0;
110       
111   switch (TYPE_CODE (index_type)) {
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 = builtin_type_long;
118     /* FALL THROUGH */
119   default:
120     if (low_bound == 1)
121       return 0;
122     break;
123   }
124
125   ada_print_scalar (index_type, (LONGEST) 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 FORMAT and
133     separates with commas. RECURSE is the recursion (nesting) level.
134     If PRETTY, uses "prettier" format. TYPE must have been decoded (as
135     by ada_coerce_to_simple_array).  */ 
136
137 static void
138 val_print_packed_array_elements (type, valaddr, bitoffset, stream, format, 
139                                  recurse, pretty)
140      struct type *type;
141      char *valaddr;
142      int bitoffset;
143      struct ui_file *stream;
144      int format;
145      int recurse;
146      enum val_prettyprint pretty;
147 {
148   unsigned int i;
149   unsigned int things_printed = 0;
150   unsigned len;
151   struct type *elttype;
152   unsigned eltlen;
153   /* Position of the array element we are examining to see
154      whether it is repeated.  */
155   unsigned int rep1;
156   /* Number of repetitions we have detected so far.  */
157   unsigned int reps;
158   unsigned long bitsize = TYPE_FIELD_BITSIZE (type, 0);
159   struct value* mark = value_mark ();
160       
161   elttype = TYPE_TARGET_TYPE (type);
162   eltlen = TYPE_LENGTH (check_typedef (elttype));
163
164   {
165     LONGEST low, high;
166     if (get_discrete_bounds (TYPE_FIELD_TYPE (type, 0), &low, &high) < 0)
167       len = 1;
168     else
169       len = high - low + 1;
170   }
171
172   i = 0;
173   annotate_array_section_begin (i, elttype);
174
175   while (i < len && things_printed < print_max)
176     {
177       struct value *v0, *v1;
178       int i0;
179
180       if (i != 0)
181         {
182           if (prettyprint_arrays)
183             {
184               fprintf_filtered (stream, ",\n");
185               print_spaces_filtered (2 + 2 * recurse, stream);
186             }
187           else
188             {
189               fprintf_filtered (stream, ", ");
190             }
191         }
192       wrap_here (n_spaces (2 + 2 * recurse));
193
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) 
209               != 0)
210             break;
211         }
212
213       if (i - i0 > repeat_count_threshold)
214         {
215           val_print (elttype, VALUE_CONTENTS (v0), 0, 0, stream, format,
216                      0, recurse + 1, pretty);
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           for (j = i0; j < i; j += 1)
226             {
227               if (j > i0) 
228                 {
229                   if (prettyprint_arrays)
230                     {
231                       fprintf_filtered (stream, ",\n");
232                       print_spaces_filtered (2 + 2 * recurse, stream);
233                     }
234                   else
235                     {
236                       fprintf_filtered (stream, ", ");
237                     }
238                   wrap_here (n_spaces (2 + 2 * recurse));
239                 }
240               val_print (elttype, VALUE_CONTENTS (v0), 0, 0, stream, format,
241                          0, recurse + 1, pretty);
242               annotate_elt ();
243             }
244         }
245       things_printed += i - i0;
246     }
247   annotate_array_section_end ();
248   if (i < len)
249     {
250       fprintf_filtered (stream, "...");
251     }
252
253   value_free_to_mark (mark);
254 }
255
256 static struct type*
257 printable_val_type (type, valaddr)
258      struct type* type;
259      char* valaddr;
260 {
261   return ada_to_fixed_type (ada_aligned_type (type), valaddr, 0, NULL);
262 }
263
264 /* Print the character C on STREAM as part of the contents of a literal
265    string whose delimiter is QUOTER.  TYPE_LEN is the length in bytes
266    (1 or 2) of the character. */
267
268 void
269 ada_emit_char (c, stream, quoter, type_len)
270      int c;
271      struct ui_file *stream;
272      int quoter;
273      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, "[\"%c\"]", quoter);
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 (string, i, type_len)
296      char* string;
297      int i;
298      int type_len;
299 {
300   if (type_len == 1)
301     return string[i];
302   else 
303     return (int) extract_unsigned_integer (string + 2*i, 2);
304 }
305
306 void
307 ada_printchar (c, stream)
308      int c;
309      struct ui_file *stream;
310 {
311   fputs_filtered ("'", stream);
312   ada_emit_char (c, stream, '\'', 1);
313   fputs_filtered ("'", stream);
314 }
315
316 /* [From print_type_scalar in typeprint.c].   Print VAL on STREAM in a
317    form appropriate for TYPE. */
318
319 void
320 ada_print_scalar (type, val, stream)
321      struct type *type;
322      LONGEST val;
323      struct ui_file *stream;
324 {
325   unsigned int i;
326   unsigned len;
327
328   CHECK_TYPEDEF (type);
329
330   switch (TYPE_CODE (type))
331     {
332
333     case TYPE_CODE_ENUM:
334       len = TYPE_NFIELDS (type);
335       for (i = 0; i < len; i++)
336         {
337           if (TYPE_FIELD_BITPOS (type, i) == val)
338             {
339               break;
340             }
341         }
342       if (i < len)
343         {
344           fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
345         }
346       else
347         {
348           print_longest (stream, 'd', 0, val);
349         }
350       break;
351
352     case TYPE_CODE_INT:
353       print_longest (stream, TYPE_UNSIGNED (type) ? 'u' : 'd', 0, val);
354       break;
355
356     case TYPE_CODE_CHAR:
357       LA_PRINT_CHAR ((unsigned char) val, stream);
358       break;
359
360     case TYPE_CODE_BOOL:
361       fprintf_filtered (stream, val ? "true" : "false");
362       break;
363
364     case TYPE_CODE_RANGE:
365       ada_print_scalar (TYPE_TARGET_TYPE (type), val, stream);
366       return;
367
368     case TYPE_CODE_UNDEF:
369     case TYPE_CODE_PTR:
370     case TYPE_CODE_ARRAY:
371     case TYPE_CODE_STRUCT:
372     case TYPE_CODE_UNION:
373     case TYPE_CODE_FUNC:
374     case TYPE_CODE_FLT:
375     case TYPE_CODE_VOID:
376     case TYPE_CODE_SET:
377     case TYPE_CODE_STRING:
378     case TYPE_CODE_ERROR:
379     case TYPE_CODE_MEMBER:
380     case TYPE_CODE_METHOD:
381     case TYPE_CODE_REF:
382       warning ("internal error: unhandled type in ada_print_scalar");
383       break;
384
385     default:
386       error ("Invalid type code in symbol table.");
387     }
388   gdb_flush (stream);
389 }
390
391 /* Print the character string STRING, printing at most LENGTH characters.
392    Printing stops early if the number hits print_max; repeat counts
393    are printed as appropriate.  Print ellipses at the end if we
394    had to stop before printing LENGTH characters, or if
395    FORCE_ELLIPSES.   TYPE_LEN is the length (1 or 2) of the character type.
396  */
397
398 static void
399 printstr (stream, string, length, force_ellipses, type_len)
400      struct ui_file *stream;
401      char *string;
402      unsigned int length;
403      int force_ellipses;
404      int type_len;
405 {
406   unsigned int i;
407   unsigned int things_printed = 0;
408   int in_quotes = 0;
409   int need_comma = 0;
410
411   if (length == 0)
412     {
413       fputs_filtered ("\"\"", stream);
414       return;
415     }
416
417   for (i = 0; i < length && things_printed < print_max; i += 1)
418     {
419       /* Position of the character we are examining
420          to see whether it is repeated.  */
421       unsigned int rep1;
422       /* Number of repetitions we have detected so far.  */
423       unsigned int reps;
424
425       QUIT;
426
427       if (need_comma)
428         {
429           fputs_filtered (", ", stream);
430           need_comma = 0;
431         }
432
433       rep1 = i + 1;
434       reps = 1;
435       while (rep1 < length && 
436              char_at(string, rep1, type_len) == char_at (string, i, type_len))
437         {
438           rep1 += 1;
439           reps += 1;
440         }
441
442       if (reps > repeat_count_threshold)
443         {
444           if (in_quotes)
445             {
446               if (inspect_it)
447                 fputs_filtered ("\\\", ", stream);
448               else
449                 fputs_filtered ("\", ", stream);
450               in_quotes = 0;
451             }
452           fputs_filtered ("'", stream);
453           ada_emit_char (char_at (string, i, type_len), stream, '\'', type_len);
454           fputs_filtered ("'", stream);
455           fprintf_filtered (stream, " <repeats %u times>", reps);
456           i = rep1 - 1;
457           things_printed += repeat_count_threshold;
458           need_comma = 1;
459         }
460       else
461         {
462           if (!in_quotes)
463             {
464               if (inspect_it)
465                 fputs_filtered ("\\\"", stream);
466               else
467                 fputs_filtered ("\"", stream);
468               in_quotes = 1;
469             }
470           ada_emit_char (char_at (string, i, type_len), stream, '"',
471                          type_len);
472           things_printed += 1;
473         }
474     }
475
476   /* Terminate the quotes if necessary.  */
477   if (in_quotes)
478     {
479       if (inspect_it)
480         fputs_filtered ("\\\"", stream);
481       else
482         fputs_filtered ("\"", stream);
483     }
484
485   if (force_ellipses || i < length)
486     fputs_filtered ("...", stream);
487 }
488
489 void
490 ada_printstr (stream, string, length, force_ellipses, width)
491      struct ui_file *stream;
492      char *string;
493      unsigned int length;
494      int force_ellipses;
495      int width;
496 {
497   printstr (stream, string, length, force_ellipses, width);
498 }
499
500
501 /* Print data of type TYPE located at VALADDR (within GDB), which came from
502    the inferior at address ADDRESS, onto stdio stream STREAM according to
503    FORMAT (a letter as for the printf % codes or 0 for natural format).  
504    The data at VALADDR is in target byte order.
505
506    If the data is printed as a string, returns the number of string characters
507    printed.
508
509    If DEREF_REF is nonzero, then dereference references, otherwise just print
510    them like pointers.
511
512    RECURSE indicates the amount of indentation to supply before
513    continuation lines; this amount is roughly twice the value of RECURSE.
514
515    When PRETTY is non-zero, prints record fields on separate lines.
516    (For some reason, the current version of gdb instead uses a global
517    variable---prettyprint_arrays--- to causes a similar effect on
518    arrays.)  */
519
520 int
521 ada_val_print (type, valaddr0, embedded_offset, address, stream,
522                format, deref_ref, recurse, pretty)
523      struct type* type;
524      char* valaddr0;
525      int embedded_offset;
526      CORE_ADDR address;
527      struct ui_file *stream;
528      int format;
529      int deref_ref;
530      int recurse;
531      enum val_prettyprint pretty;
532 {
533   struct ada_val_print_args args;
534   args.type = type; args.valaddr0 = valaddr0; 
535   args.embedded_offset = embedded_offset;
536   args.address = address;
537   args.stream = stream;
538   args.format = format;
539   args.deref_ref = deref_ref;
540   args.recurse = recurse;
541   args.pretty = pretty;
542
543   return catch_errors (ada_val_print_stub, &args, NULL, RETURN_MASK_ALL);
544 }
545
546 /* Helper for ada_val_print; used as argument to catch_errors to
547    unmarshal the arguments to ada_val_print_1, which does the work. */
548 static int
549 ada_val_print_stub (PTR args0)
550 {
551   struct ada_val_print_args* argsp = (struct ada_val_print_args*) args0;
552   return ada_val_print_1 (argsp->type, argsp->valaddr0, argsp->embedded_offset,
553                           argsp->address, argsp->stream, argsp->format,
554                           argsp->deref_ref, argsp->recurse,
555                           argsp->pretty);
556 }
557
558 /* See the comment on ada_val_print.  This function differs in that it
559  * does not catch evaluation errors (leaving that to ada_val_print). */
560
561 static int
562 ada_val_print_1 (type, valaddr0, embedded_offset, address, stream,
563                  format, deref_ref, recurse, pretty)
564      struct type* type;
565      char* valaddr0;
566      int embedded_offset;
567      CORE_ADDR address;
568      struct ui_file *stream;
569      int format;
570      int deref_ref;
571      int recurse;
572      enum val_prettyprint pretty;
573 {
574   unsigned int len;
575   int i;
576   struct type *elttype;
577   unsigned int eltlen;
578   LONGEST val;
579   CORE_ADDR addr;
580   char* valaddr = valaddr0 + embedded_offset;
581
582   CHECK_TYPEDEF (type);
583
584   if (ada_is_array_descriptor (type) || ada_is_packed_array_type (type))
585     {
586       int retn;
587       struct value* mark = value_mark ();
588       struct value* val;
589       val = value_from_contents_and_address (type, valaddr, address);
590       val = ada_coerce_to_simple_array_ptr (val);
591       if (val == NULL)
592         {
593           fprintf_filtered (stream, "(null)");
594           retn = 0;
595         }
596       else
597         retn = ada_val_print_1 (VALUE_TYPE (val), VALUE_CONTENTS (val), 0,
598                                 VALUE_ADDRESS (val), stream, format, 
599                                 deref_ref, recurse, pretty);
600       value_free_to_mark (mark);
601       return retn;
602     }
603
604   valaddr = ada_aligned_value_addr (type, valaddr);
605   embedded_offset -= valaddr - valaddr0 - embedded_offset;
606   type = printable_val_type (type, valaddr);
607
608   switch (TYPE_CODE (type))
609     {
610     default:
611       return c_val_print (type, valaddr0, embedded_offset, address, stream, 
612                           format, deref_ref, recurse, pretty);
613
614     case TYPE_CODE_INT:
615     case TYPE_CODE_RANGE:
616       if (ada_is_fixed_point_type (type))
617         {
618           LONGEST v = unpack_long (type, valaddr);
619           int len = TYPE_LENGTH (type);
620
621           fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
622                             (double) ada_fixed_to_float (type, v));
623           return 0;
624         }
625       else if (ada_is_vax_floating_type (type))
626         {
627           struct value* val = 
628             value_from_contents_and_address (type, valaddr, address);
629           struct value* func = ada_vax_float_print_function (type);
630           if (func != 0)
631             {
632               static struct type* parray_of_char = NULL;
633               struct value* printable_val;
634
635               if (parray_of_char == NULL) 
636                 parray_of_char = 
637                   make_pointer_type 
638                     (create_array_type 
639                       (NULL, builtin_type_char,
640                        create_range_type (NULL, builtin_type_int, 0, 32)),
641                      NULL);
642
643               printable_val = 
644                 value_ind (value_cast (parray_of_char,
645                                        call_function_by_hand (func, 1, &val)));
646               
647               fprintf_filtered (stream, "%s", VALUE_CONTENTS (printable_val));
648               return 0;
649             }
650           /* No special printing function.  Do as best we can. */
651         }
652       else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
653         {
654           struct type* target_type = TYPE_TARGET_TYPE (type);
655           if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
656             {
657               /* Obscure case of range type that has different length from
658                  its base type.  Perform a conversion, or we will get a
659                  nonsense value.  Actually, we could use the same
660                  code regardless of lengths; I'm just avoiding a cast. */
661               struct value* v = 
662                 value_cast (target_type, 
663                             value_from_contents_and_address (type, valaddr, 0));
664               return ada_val_print_1 (target_type, VALUE_CONTENTS (v), 0, 0,
665                                       stream, format, 0, recurse + 1, pretty);
666             }
667           else
668             return ada_val_print_1 (TYPE_TARGET_TYPE (type), 
669                                     valaddr0, embedded_offset,
670                                     address,  stream, format, deref_ref, 
671                                     recurse, pretty);
672         }
673       else 
674         {
675           format = format ? format : output_format;
676           if (format)
677             {
678               print_scalar_formatted (valaddr, type, format, 0, stream);
679             }
680           else
681             {
682               val_print_type_code_int (type, valaddr, stream);
683               if (ada_is_character_type (type))
684                 {
685                   fputs_filtered (" ", stream);
686                   ada_printchar ((unsigned char) unpack_long (type, valaddr),
687                                  stream);
688                 }
689             }
690           return 0;
691         }
692
693     case TYPE_CODE_ENUM:
694       if (format)
695         {
696           print_scalar_formatted (valaddr, type, format, 0, stream);
697           break;
698         }
699       len = TYPE_NFIELDS (type);
700       val = unpack_long (type, valaddr);
701       for (i = 0; i < len; i++)
702         {
703           QUIT;
704           if (val == TYPE_FIELD_BITPOS (type, i))
705             {
706               break;
707             }
708         }
709       if (i < len)
710         {
711           const char* name = ada_enum_name (TYPE_FIELD_NAME (type, i));
712           if (name[0] == '\'') 
713             fprintf_filtered (stream, "%ld %s", (long) val, name);
714           else
715             fputs_filtered (name, stream);
716         }
717       else
718         {
719           print_longest (stream, 'd', 0, val);
720         }
721       break;
722       
723     case TYPE_CODE_UNION:
724     case TYPE_CODE_STRUCT:
725       if (ada_is_bogus_array_descriptor (type))
726         {
727           fprintf_filtered (stream, "(...?)");
728           return 0;
729         }                             
730       else
731         {
732           print_record (type, valaddr, stream, format,
733                         recurse, pretty);
734           return 0;
735         }
736
737     case TYPE_CODE_ARRAY:
738       if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
739         {
740           elttype = TYPE_TARGET_TYPE (type);
741           eltlen = TYPE_LENGTH (elttype);
742           len = TYPE_LENGTH (type) / eltlen;
743               
744           /* For an array of chars, print with string syntax.  */
745           if (ada_is_string_type (type) 
746               && (format == 0 || format == 's'))
747             {
748               if (prettyprint_arrays)
749                 {
750                   print_spaces_filtered (2 + 2 * recurse, stream);
751                 }
752               /* If requested, look for the first null char and only print
753                  elements up to it.  */
754               if (stop_print_at_null)
755                 {
756                   int temp_len;
757                   
758                   /* Look for a NULL char. */
759                   for (temp_len = 0;
760                        temp_len < len && temp_len < print_max
761                        && char_at (valaddr, temp_len, eltlen) != 0;
762                        temp_len += 1);
763                   len = temp_len;
764                 }
765               
766               printstr (stream, valaddr, len, 0, eltlen);
767             }
768           else
769             {
770               len = 0;
771               fprintf_filtered (stream, "(");
772               print_optional_low_bound (stream, type);
773               if (TYPE_FIELD_BITSIZE (type, 0) > 0) 
774                 val_print_packed_array_elements (type, valaddr, 0, stream,
775                                                  format, recurse,
776                                                  pretty);
777               else
778                 val_print_array_elements (type, valaddr, address, stream,
779                                           format, deref_ref, recurse,
780                                           pretty, 0);
781               fprintf_filtered (stream, ")");
782             }
783           gdb_flush (stream);
784           return len;
785         }
786
787     case TYPE_CODE_REF:
788       elttype = check_typedef (TYPE_TARGET_TYPE (type));
789       if (addressprint)
790         {
791           fprintf_filtered (stream, "@");
792           print_address_numeric
793             (extract_address (valaddr,
794                               TARGET_PTR_BIT / HOST_CHAR_BIT), 1, stream);
795           if (deref_ref)
796             fputs_filtered (": ", stream);
797         }
798       /* De-reference the reference */
799       if (deref_ref)
800         {
801           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
802             {
803               LONGEST deref_val_int = (LONGEST) 
804                 unpack_pointer (lookup_pointer_type (builtin_type_void), 
805                                 valaddr);
806               if (deref_val_int != 0) 
807                 {
808                   struct value* deref_val =
809                     ada_value_ind (value_from_longest 
810                                    (lookup_pointer_type (elttype), 
811                                     deref_val_int));
812                   val_print (VALUE_TYPE (deref_val),
813                              VALUE_CONTENTS (deref_val), 0,
814                              VALUE_ADDRESS (deref_val), stream, format,
815                              deref_ref, recurse + 1, pretty);
816                 }
817               else
818                 fputs_filtered ("(null)", stream);
819             }
820           else
821             fputs_filtered ("???", stream);
822         }
823       break;
824     }
825   return 0;
826 }
827
828 static int
829 print_variant_part (type, field_num, valaddr, 
830                     stream, format, recurse, pretty, comma_needed,
831                     outer_type, outer_valaddr)
832      struct type *type;
833      int field_num;
834      char *valaddr;
835      struct ui_file *stream;
836      int format;
837      int recurse;
838      enum val_prettyprint pretty;
839      int comma_needed;
840      struct type *outer_type;
841      char *outer_valaddr;
842 {
843   struct type *var_type = TYPE_FIELD_TYPE (type, field_num);
844   int which = 
845     ada_which_variant_applies (var_type, outer_type, outer_valaddr);
846
847   if (which < 0)
848     return 0;
849   else
850     return print_field_values 
851       (TYPE_FIELD_TYPE (var_type, which),
852        valaddr + TYPE_FIELD_BITPOS (type, field_num) / HOST_CHAR_BIT
853        + TYPE_FIELD_BITPOS (var_type, which) / HOST_CHAR_BIT,
854        stream, format, recurse, pretty,
855        comma_needed, outer_type, outer_valaddr);
856 }
857
858 int
859 ada_value_print (val0, stream, format, pretty)
860      struct value* val0;
861      struct ui_file *stream;
862      int format;
863      enum val_prettyprint pretty;
864 {
865   char* valaddr = VALUE_CONTENTS (val0);
866   CORE_ADDR address = VALUE_ADDRESS (val0) + VALUE_OFFSET (val0);
867   struct type* type = 
868     ada_to_fixed_type (VALUE_TYPE (val0), valaddr, address, NULL);
869   struct value* val = value_from_contents_and_address (type, valaddr, address);
870
871   /* If it is a pointer, indicate what it points to. */
872   if (TYPE_CODE (type) == TYPE_CODE_PTR ||
873       TYPE_CODE (type) == TYPE_CODE_REF)
874     {
875       /* Hack:  remove (char *) for char strings.  Their
876          type is indicated by the quoted string anyway. */
877       if (TYPE_CODE (type) == TYPE_CODE_PTR &&
878           TYPE_LENGTH (TYPE_TARGET_TYPE (type)) == sizeof(char) &&
879           TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_INT &&
880           !TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
881         {
882           /* Print nothing */
883         }
884       else
885         {
886           fprintf_filtered (stream, "(");
887           type_print (type, "", stream, -1);
888           fprintf_filtered (stream, ") ");
889         }
890     }
891   else if (ada_is_array_descriptor (type)) 
892     {
893       fprintf_filtered (stream, "(");
894       type_print (type, "", stream, -1);
895       fprintf_filtered (stream, ") ");
896     }
897   else if (ada_is_bogus_array_descriptor (type))
898     {
899       fprintf_filtered (stream, "(");
900       type_print (type, "", stream, -1);
901       fprintf_filtered (stream, ") (...?)");
902       return 0;
903     }
904   return (val_print (type, VALUE_CONTENTS (val), 0, address, 
905                      stream, format, 1, 0, pretty));
906 }
907  
908 static void
909 print_record (type, valaddr, stream, format, recurse, pretty)
910      struct type *type;
911      char *valaddr;
912      struct ui_file *stream;
913      int format;
914      int recurse;
915      enum val_prettyprint pretty;
916 {
917   CHECK_TYPEDEF (type);
918
919   fprintf_filtered (stream, "(");
920
921   if (print_field_values (type, valaddr, stream, format, recurse, pretty,
922                           0, type, valaddr) != 0
923       && pretty)
924     {
925       fprintf_filtered (stream, "\n");
926       print_spaces_filtered (2 * recurse, stream);
927     }
928
929   fprintf_filtered (stream, ")");
930 }
931
932 /* Print out fields of value at VALADDR having structure type TYPE.
933   
934    TYPE, VALADDR, STREAM, FORMAT, RECURSE, and PRETTY have the
935    same meanings as in ada_print_value and ada_val_print.   
936
937    OUTER_TYPE and OUTER_VALADDR give type and address of enclosing record
938    (used to get discriminant values when printing variant parts).
939
940    COMMA_NEEDED is 1 if fields have been printed at the current recursion 
941    level, so that a comma is needed before any field printed by this
942    call. 
943
944    Returns 1 if COMMA_NEEDED or any fields were printed. */
945
946 static int
947 print_field_values (type, valaddr, stream, format, recurse, pretty, 
948                     comma_needed, outer_type, outer_valaddr)
949      struct type *type;
950      char *valaddr;
951      struct ui_file *stream;
952      int format;
953      int recurse;
954      enum val_prettyprint pretty;
955      int comma_needed;
956      struct type *outer_type;
957      char *outer_valaddr;
958 {
959   int i, len;
960
961   len = TYPE_NFIELDS (type);
962
963   for (i = 0; i < len; i += 1)
964     {
965       if (ada_is_ignored_field (type, i))
966           continue;
967
968       if (ada_is_wrapper_field (type, i))
969         {
970           comma_needed = 
971             print_field_values (TYPE_FIELD_TYPE (type, i),
972                                 valaddr 
973                                 + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
974                                 stream, format, recurse, pretty,
975                                 comma_needed, type, valaddr);
976           continue;
977         }
978       else if (ada_is_variant_part (type, i))
979         {
980           comma_needed =
981             print_variant_part (type, i, valaddr,
982                                 stream, format, recurse, pretty, comma_needed,
983                                 outer_type, outer_valaddr);
984           continue;
985         }
986
987       if (comma_needed)
988         fprintf_filtered (stream, ", ");
989       comma_needed = 1;
990
991       if (pretty)
992         {
993           fprintf_filtered (stream, "\n");
994           print_spaces_filtered (2 + 2 * recurse, stream);
995         }
996       else 
997         {
998           wrap_here (n_spaces (2 + 2 * recurse));
999         }
1000       if (inspect_it)
1001         {
1002           if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
1003             fputs_filtered ("\"( ptr \"", stream);
1004           else
1005             fputs_filtered ("\"( nodef \"", stream);
1006           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1007                                    language_cplus, DMGL_NO_OPTS);
1008           fputs_filtered ("\" \"", stream);
1009           fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
1010                                    language_cplus, DMGL_NO_OPTS);
1011           fputs_filtered ("\") \"", stream);
1012         }
1013       else
1014         {
1015           annotate_field_begin (TYPE_FIELD_TYPE (type, i));
1016           fprintf_filtered (stream, "%.*s", 
1017                             ada_name_prefix_len (TYPE_FIELD_NAME (type, i)),
1018                             TYPE_FIELD_NAME (type, i));
1019           annotate_field_name_end ();
1020           fputs_filtered (" => ", stream);
1021           annotate_field_value ();
1022         }
1023
1024       if (TYPE_FIELD_PACKED (type, i))
1025         {
1026           struct value* v;
1027
1028           /* Bitfields require special handling, especially due to byte
1029              order problems.  */
1030           if (TYPE_CPLUS_SPECIFIC (type) != NULL
1031               && TYPE_FIELD_IGNORE (type, i))
1032             {
1033               fputs_filtered ("<optimized out or zero length>", stream);
1034             }
1035           else
1036             {
1037               int bit_pos = TYPE_FIELD_BITPOS (type, i);
1038               int bit_size = TYPE_FIELD_BITSIZE (type, i);
1039       
1040               adjust_type_signedness (TYPE_FIELD_TYPE (type, i));
1041               v = ada_value_primitive_packed_val (NULL, valaddr,
1042                                                   bit_pos / HOST_CHAR_BIT,
1043                                                   bit_pos % HOST_CHAR_BIT,
1044                                                   bit_size, 
1045                                                   TYPE_FIELD_TYPE (type, i));
1046               val_print (TYPE_FIELD_TYPE(type, i), VALUE_CONTENTS (v), 0, 0,
1047                          stream, format, 0, recurse + 1, pretty);
1048             }
1049         }
1050       else
1051           ada_val_print (TYPE_FIELD_TYPE (type, i), 
1052                          valaddr + TYPE_FIELD_BITPOS (type, i) / HOST_CHAR_BIT,
1053                          0, 0, stream, format, 0, recurse + 1, pretty);
1054       annotate_field_end ();
1055     }
1056
1057   return comma_needed;
1058 }