* printcmd.c (print_formatted): Use val_print_scalar_formatted
[external/binutils.git] / gdb / p-valprint.c
1 /* Support for printing Pascal values for GDB, the GNU debugger.
2
3    Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011
4    Free Software Foundation, Inc.
5
6    This file is part of GDB.
7
8    This program is free software; you can redistribute it and/or modify
9    it under the terms of the GNU General Public License as published by
10    the Free Software Foundation; either version 3 of the License, or
11    (at your option) any later version.
12
13    This program is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16    GNU General Public License for more details.
17
18    You should have received a copy of the GNU General Public License
19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
20
21 /* This file is derived from c-valprint.c */
22
23 #include "defs.h"
24 #include "gdb_obstack.h"
25 #include "symtab.h"
26 #include "gdbtypes.h"
27 #include "expression.h"
28 #include "value.h"
29 #include "command.h"
30 #include "gdbcmd.h"
31 #include "gdbcore.h"
32 #include "demangle.h"
33 #include "valprint.h"
34 #include "typeprint.h"
35 #include "language.h"
36 #include "target.h"
37 #include "annotate.h"
38 #include "p-lang.h"
39 #include "cp-abi.h"
40 #include "cp-support.h"
41 \f
42
43
44
45 /* Print data of type TYPE located at VALADDR (within GDB), which came from
46    the inferior at address ADDRESS, onto stdio stream STREAM according to
47    OPTIONS.  The data at VALADDR is in target byte order.
48
49    If the data are a string pointer, returns the number of string characters
50    printed.  */
51
52
53 int
54 pascal_val_print (struct type *type, const gdb_byte *valaddr,
55                   int embedded_offset, CORE_ADDR address,
56                   struct ui_file *stream, int recurse,
57                   const struct value *original_value,
58                   const struct value_print_options *options)
59 {
60   struct gdbarch *gdbarch = get_type_arch (type);
61   enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
62   unsigned int i = 0;   /* Number of characters printed */
63   unsigned len;
64   LONGEST low_bound, high_bound;
65   struct type *elttype;
66   unsigned eltlen;
67   int length_pos, length_size, string_pos;
68   struct type *char_type;
69   LONGEST val;
70   CORE_ADDR addr;
71
72   CHECK_TYPEDEF (type);
73   switch (TYPE_CODE (type))
74     {
75     case TYPE_CODE_ARRAY:
76       if (get_array_bounds (type, &low_bound, &high_bound)) 
77         {
78           len = high_bound - low_bound + 1;
79           elttype = check_typedef (TYPE_TARGET_TYPE (type));
80           eltlen = TYPE_LENGTH (elttype);
81           if (options->prettyprint_arrays)
82             {
83               print_spaces_filtered (2 + 2 * recurse, stream);
84             }
85           /* If 's' format is used, try to print out as string.
86              If no format is given, print as string if element type
87              is of TYPE_CODE_CHAR and element size is 1,2 or 4.  */
88           if (options->format == 's'
89               || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
90                   && TYPE_CODE (elttype) == TYPE_CODE_CHAR
91                   && options->format == 0))
92             {
93               /* If requested, look for the first null char and only print
94                  elements up to it.  */
95               if (options->stop_print_at_null)
96                 {
97                   unsigned int temp_len;
98
99                   /* Look for a NULL char.  */
100                   for (temp_len = 0;
101                        extract_unsigned_integer (valaddr + embedded_offset +
102                                                  temp_len * eltlen, eltlen,
103                                                  byte_order)
104                        && temp_len < len && temp_len < options->print_max;
105                        temp_len++);
106                   len = temp_len;
107                 }
108
109               LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
110                                valaddr + embedded_offset, len, NULL, 0,
111                                options);
112               i = len;
113             }
114           else
115             {
116               fprintf_filtered (stream, "{");
117               /* If this is a virtual function table, print the 0th
118                  entry specially, and the rest of the members normally.  */
119               if (pascal_object_is_vtbl_ptr_type (elttype))
120                 {
121                   i = 1;
122                   fprintf_filtered (stream, "%d vtable entries", len - 1);
123                 }
124               else
125                 {
126                   i = 0;
127                 }
128               val_print_array_elements (type, valaddr, embedded_offset,
129                                         address, stream, recurse,
130                                         original_value, options, i);
131               fprintf_filtered (stream, "}");
132             }
133           break;
134         }
135       /* Array of unspecified length: treat like pointer to first elt.  */
136       addr = address;
137       goto print_unpacked_pointer;
138
139     case TYPE_CODE_PTR:
140       if (options->format && options->format != 's')
141         {
142           val_print_scalar_formatted (type, valaddr, embedded_offset,
143                                       original_value, options, 0, stream);
144           break;
145         }
146       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
147         {
148           /* Print the unmangled name if desired.  */
149           /* Print vtable entry - we only get here if we ARE using
150              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.)  */
151           /* Extract the address, assume that it is unsigned.  */
152           addr = extract_unsigned_integer (valaddr + embedded_offset,
153                                            TYPE_LENGTH (type), byte_order);
154           print_address_demangle (gdbarch, addr, stream, demangle);
155           break;
156         }
157       elttype = check_typedef (TYPE_TARGET_TYPE (type));
158
159       addr = unpack_pointer (type, valaddr + embedded_offset);
160     print_unpacked_pointer:
161       elttype = check_typedef (TYPE_TARGET_TYPE (type));
162
163       if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
164         {
165           /* Try to print what function it points to.  */
166           print_address_demangle (gdbarch, addr, stream, demangle);
167           /* Return value is irrelevant except for string pointers.  */
168           return (0);
169         }
170
171       if (options->addressprint && options->format != 's')
172         {
173           fputs_filtered (paddress (gdbarch, addr), stream);
174         }
175
176       /* For a pointer to char or unsigned char, also print the string
177          pointed to, unless pointer is null.  */
178       if (((TYPE_LENGTH (elttype) == 1
179            && (TYPE_CODE (elttype) == TYPE_CODE_INT
180               || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
181           || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
182               && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
183           && (options->format == 0 || options->format == 's')
184           && addr != 0)
185         {
186           /* No wide string yet.  */
187           i = val_print_string (elttype, NULL, addr, -1, stream, options);
188         }
189       /* Also for pointers to pascal strings.  */
190       /* Note: this is Free Pascal specific:
191          as GDB does not recognize stabs pascal strings
192          Pascal strings are mapped to records
193          with lowercase names PM.  */
194       if (is_pascal_string_type (elttype, &length_pos, &length_size,
195                                  &string_pos, &char_type, NULL)
196           && addr != 0)
197         {
198           ULONGEST string_length;
199           void *buffer;
200
201           buffer = xmalloc (length_size);
202           read_memory (addr + length_pos, buffer, length_size);
203           string_length = extract_unsigned_integer (buffer, length_size,
204                                                     byte_order);
205           xfree (buffer);
206           i = val_print_string (char_type, NULL,
207                                 addr + string_pos, string_length,
208                                 stream, options);
209         }
210       else if (pascal_object_is_vtbl_member (type))
211         {
212           /* Print vtbl's nicely.  */
213           CORE_ADDR vt_address = unpack_pointer (type,
214                                                  valaddr + embedded_offset);
215           struct minimal_symbol *msymbol =
216             lookup_minimal_symbol_by_pc (vt_address);
217
218           if ((msymbol != NULL)
219               && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
220             {
221               fputs_filtered (" <", stream);
222               fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
223               fputs_filtered (">", stream);
224             }
225           if (vt_address && options->vtblprint)
226             {
227               struct value *vt_val;
228               struct symbol *wsym = (struct symbol *) NULL;
229               struct type *wtype;
230               struct block *block = (struct block *) NULL;
231               int is_this_fld;
232
233               if (msymbol != NULL)
234                 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
235                                       VAR_DOMAIN, &is_this_fld);
236
237               if (wsym)
238                 {
239                   wtype = SYMBOL_TYPE (wsym);
240                 }
241               else
242                 {
243                   wtype = TYPE_TARGET_TYPE (type);
244                 }
245               vt_val = value_at (wtype, vt_address);
246               common_val_print (vt_val, stream, recurse + 1, options,
247                                 current_language);
248               if (options->pretty)
249                 {
250                   fprintf_filtered (stream, "\n");
251                   print_spaces_filtered (2 + 2 * recurse, stream);
252                 }
253             }
254         }
255
256       /* Return number of characters printed, including the terminating
257          '\0' if we reached the end.  val_print_string takes care including
258          the terminating '\0' if necessary.  */
259       return i;
260
261       break;
262
263     case TYPE_CODE_REF:
264       elttype = check_typedef (TYPE_TARGET_TYPE (type));
265       if (options->addressprint)
266         {
267           CORE_ADDR addr
268             = extract_typed_address (valaddr + embedded_offset, type);
269
270           fprintf_filtered (stream, "@");
271           fputs_filtered (paddress (gdbarch, addr), stream);
272           if (options->deref_ref)
273             fputs_filtered (": ", stream);
274         }
275       /* De-reference the reference.  */
276       if (options->deref_ref)
277         {
278           if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
279             {
280               struct value *deref_val =
281                 value_at
282                 (TYPE_TARGET_TYPE (type),
283                  unpack_pointer (type, valaddr + embedded_offset));
284
285               common_val_print (deref_val, stream, recurse + 1, options,
286                                 current_language);
287             }
288           else
289             fputs_filtered ("???", stream);
290         }
291       break;
292
293     case TYPE_CODE_UNION:
294       if (recurse && !options->unionprint)
295         {
296           fprintf_filtered (stream, "{...}");
297           break;
298         }
299       /* Fall through.  */
300     case TYPE_CODE_STRUCT:
301       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
302         {
303           /* Print the unmangled name if desired.  */
304           /* Print vtable entry - we only get here if NOT using
305              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.)  */
306           /* Extract the address, assume that it is unsigned.  */
307           print_address_demangle
308             (gdbarch,
309              extract_unsigned_integer (valaddr + embedded_offset
310                                        + TYPE_FIELD_BITPOS (type,
311                                                             VTBL_FNADDR_OFFSET) / 8,
312                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type,
313                                                                      VTBL_FNADDR_OFFSET)),
314                                        byte_order),
315              stream, demangle);
316         }
317       else
318         {
319           if (is_pascal_string_type (type, &length_pos, &length_size,
320                                      &string_pos, &char_type, NULL))
321             {
322               len = extract_unsigned_integer (valaddr + embedded_offset
323                                               + length_pos, length_size,
324                                               byte_order);
325               LA_PRINT_STRING (stream, char_type, 
326                                valaddr + embedded_offset + string_pos,
327                                len, NULL, 0, options);
328             }
329           else
330             pascal_object_print_value_fields (type, valaddr, embedded_offset,
331                                               address, stream, recurse,
332                                               original_value, options,
333                                               NULL, 0);
334         }
335       break;
336
337     case TYPE_CODE_ENUM:
338       if (options->format)
339         {
340           val_print_scalar_formatted (type, valaddr, embedded_offset,
341                                       original_value, options, 0, stream);
342           break;
343         }
344       len = TYPE_NFIELDS (type);
345       val = unpack_long (type, valaddr + embedded_offset);
346       for (i = 0; i < len; i++)
347         {
348           QUIT;
349           if (val == TYPE_FIELD_BITPOS (type, i))
350             {
351               break;
352             }
353         }
354       if (i < len)
355         {
356           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
357         }
358       else
359         {
360           print_longest (stream, 'd', 0, val);
361         }
362       break;
363
364     case TYPE_CODE_FLAGS:
365       if (options->format)
366         val_print_scalar_formatted (type, valaddr, embedded_offset,
367                                     original_value, options, 0, stream);
368       else
369         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
370       break;
371
372     case TYPE_CODE_FUNC:
373       if (options->format)
374         {
375           val_print_scalar_formatted (type, valaddr, embedded_offset,
376                                       original_value, options, 0, stream);
377           break;
378         }
379       /* FIXME, we should consider, at least for ANSI C language, eliminating
380          the distinction made between FUNCs and POINTERs to FUNCs.  */
381       fprintf_filtered (stream, "{");
382       type_print (type, "", stream, -1);
383       fprintf_filtered (stream, "} ");
384       /* Try to print what function it points to, and its address.  */
385       print_address_demangle (gdbarch, address, stream, demangle);
386       break;
387
388     case TYPE_CODE_BOOL:
389       if (options->format || options->output_format)
390         {
391           struct value_print_options opts = *options;
392
393           opts.format = (options->format ? options->format
394                          : options->output_format);
395           val_print_scalar_formatted (type, valaddr, embedded_offset,
396                                       original_value, &opts, 0, stream);
397         }
398       else
399         {
400           val = unpack_long (type, valaddr + embedded_offset);
401           if (val == 0)
402             fputs_filtered ("false", stream);
403           else if (val == 1)
404             fputs_filtered ("true", stream);
405           else
406             {
407               fputs_filtered ("true (", stream);
408               fprintf_filtered (stream, "%ld)", (long int) val);
409             }
410         }
411       break;
412
413     case TYPE_CODE_RANGE:
414       /* FIXME: create_range_type does not set the unsigned bit in a
415          range type (I think it probably should copy it from the target
416          type), so we won't print values which are too large to
417          fit in a signed integer correctly.  */
418       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
419          print with the target type, though, because the size of our type
420          and the target type might differ).  */
421       /* FALLTHROUGH */
422
423     case TYPE_CODE_INT:
424       if (options->format || options->output_format)
425         {
426           struct value_print_options opts = *options;
427
428           opts.format = (options->format ? options->format
429                          : options->output_format);
430           val_print_scalar_formatted (type, valaddr, embedded_offset,
431                                       original_value, &opts, 0, stream);
432         }
433       else
434         {
435           val_print_type_code_int (type, valaddr + embedded_offset, stream);
436         }
437       break;
438
439     case TYPE_CODE_CHAR:
440       if (options->format || options->output_format)
441         {
442           struct value_print_options opts = *options;
443
444           opts.format = (options->format ? options->format
445                          : options->output_format);
446           val_print_scalar_formatted (type, valaddr, embedded_offset,
447                                       original_value, &opts, 0, stream);
448         }
449       else
450         {
451           val = unpack_long (type, valaddr + embedded_offset);
452           if (TYPE_UNSIGNED (type))
453             fprintf_filtered (stream, "%u", (unsigned int) val);
454           else
455             fprintf_filtered (stream, "%d", (int) val);
456           fputs_filtered (" ", stream);
457           LA_PRINT_CHAR ((unsigned char) val, type, stream);
458         }
459       break;
460
461     case TYPE_CODE_FLT:
462       if (options->format)
463         {
464           val_print_scalar_formatted (type, valaddr, embedded_offset,
465                                       original_value, options, 0, stream);
466         }
467       else
468         {
469           print_floating (valaddr + embedded_offset, type, stream);
470         }
471       break;
472
473     case TYPE_CODE_BITSTRING:
474     case TYPE_CODE_SET:
475       elttype = TYPE_INDEX_TYPE (type);
476       CHECK_TYPEDEF (elttype);
477       if (TYPE_STUB (elttype))
478         {
479           fprintf_filtered (stream, "<incomplete type>");
480           gdb_flush (stream);
481           break;
482         }
483       else
484         {
485           struct type *range = elttype;
486           LONGEST low_bound, high_bound;
487           int i;
488           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
489           int need_comma = 0;
490
491           if (is_bitstring)
492             fputs_filtered ("B'", stream);
493           else
494             fputs_filtered ("[", stream);
495
496           i = get_discrete_bounds (range, &low_bound, &high_bound);
497           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
498             {
499               /* If we know the size of the set type, we can figure out the
500               maximum value.  */
501               i = 0;
502               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
503               TYPE_HIGH_BOUND (range) = high_bound;
504             }
505         maybe_bad_bstring:
506           if (i < 0)
507             {
508               fputs_filtered ("<error value>", stream);
509               goto done;
510             }
511
512           for (i = low_bound; i <= high_bound; i++)
513             {
514               int element = value_bit_index (type,
515                                              valaddr + embedded_offset, i);
516
517               if (element < 0)
518                 {
519                   i = element;
520                   goto maybe_bad_bstring;
521                 }
522               if (is_bitstring)
523                 fprintf_filtered (stream, "%d", element);
524               else if (element)
525                 {
526                   if (need_comma)
527                     fputs_filtered (", ", stream);
528                   print_type_scalar (range, i, stream);
529                   need_comma = 1;
530
531                   if (i + 1 <= high_bound
532                       && value_bit_index (type,
533                                           valaddr + embedded_offset, ++i))
534                     {
535                       int j = i;
536
537                       fputs_filtered ("..", stream);
538                       while (i + 1 <= high_bound
539                              && value_bit_index (type,
540                                                  valaddr + embedded_offset,
541                                                  ++i))
542                         j = i;
543                       print_type_scalar (range, j, stream);
544                     }
545                 }
546             }
547         done:
548           if (is_bitstring)
549             fputs_filtered ("'", stream);
550           else
551             fputs_filtered ("]", stream);
552         }
553       break;
554
555     case TYPE_CODE_VOID:
556       fprintf_filtered (stream, "void");
557       break;
558
559     case TYPE_CODE_ERROR:
560       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
561       break;
562
563     case TYPE_CODE_UNDEF:
564       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
565          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
566          and no complete type for struct foo in that file.  */
567       fprintf_filtered (stream, "<incomplete type>");
568       break;
569
570     default:
571       error (_("Invalid pascal type code %d in symbol table."),
572              TYPE_CODE (type));
573     }
574   gdb_flush (stream);
575   return (0);
576 }
577 \f
578 int
579 pascal_value_print (struct value *val, struct ui_file *stream,
580                     const struct value_print_options *options)
581 {
582   struct type *type = value_type (val);
583   struct value_print_options opts = *options;
584
585   opts.deref_ref = 1;
586
587   /* If it is a pointer, indicate what it points to.
588
589      Print type also if it is a reference.
590
591      Object pascal: if it is a member pointer, we will take care
592      of that when we print it.  */
593   if (TYPE_CODE (type) == TYPE_CODE_PTR
594       || TYPE_CODE (type) == TYPE_CODE_REF)
595     {
596       /* Hack:  remove (char *) for char strings.  Their
597          type is indicated by the quoted string anyway.  */
598       if (TYPE_CODE (type) == TYPE_CODE_PTR 
599           && TYPE_NAME (type) == NULL
600           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
601           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
602         {
603           /* Print nothing.  */
604         }
605       else
606         {
607           fprintf_filtered (stream, "(");
608           type_print (type, "", stream, -1);
609           fprintf_filtered (stream, ") ");
610         }
611     }
612   return common_val_print (val, stream, 0, &opts, current_language);
613 }
614
615
616 static void
617 show_pascal_static_field_print (struct ui_file *file, int from_tty,
618                                 struct cmd_list_element *c, const char *value)
619 {
620   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
621                     value);
622 }
623
624 static struct obstack dont_print_vb_obstack;
625 static struct obstack dont_print_statmem_obstack;
626
627 static void pascal_object_print_static_field (struct value *,
628                                               struct ui_file *, int,
629                                               const struct value_print_options *);
630
631 static void pascal_object_print_value (struct type *, const gdb_byte *,
632                                        int,
633                                        CORE_ADDR, struct ui_file *, int,
634                                        const struct value *,
635                                        const struct value_print_options *,
636                                        struct type **);
637
638 /* It was changed to this after 2.4.5.  */
639 const char pascal_vtbl_ptr_name[] =
640 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
641
642 /* Return truth value for assertion that TYPE is of the type
643    "pointer to virtual function".  */
644
645 int
646 pascal_object_is_vtbl_ptr_type (struct type *type)
647 {
648   char *typename = type_name_no_tag (type);
649
650   return (typename != NULL
651           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
652 }
653
654 /* Return truth value for the assertion that TYPE is of the type
655    "pointer to virtual function table".  */
656
657 int
658 pascal_object_is_vtbl_member (struct type *type)
659 {
660   if (TYPE_CODE (type) == TYPE_CODE_PTR)
661     {
662       type = TYPE_TARGET_TYPE (type);
663       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
664         {
665           type = TYPE_TARGET_TYPE (type);
666           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
667                                                            thunks.  */
668               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
669             {
670               /* Virtual functions tables are full of pointers
671                  to virtual functions.  */
672               return pascal_object_is_vtbl_ptr_type (type);
673             }
674         }
675     }
676   return 0;
677 }
678
679 /* Mutually recursive subroutines of pascal_object_print_value and
680    c_val_print to print out a structure's fields:
681    pascal_object_print_value_fields and pascal_object_print_value.
682
683    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
684    same meanings as in pascal_object_print_value and c_val_print.
685
686    DONT_PRINT is an array of baseclass types that we
687    should not print, or zero if called from top level.  */
688
689 void
690 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
691                                   int offset,
692                                   CORE_ADDR address, struct ui_file *stream,
693                                   int recurse,
694                                   const struct value *val,
695                                   const struct value_print_options *options,
696                                   struct type **dont_print_vb,
697                                   int dont_print_statmem)
698 {
699   int i, len, n_baseclasses;
700   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
701
702   CHECK_TYPEDEF (type);
703
704   fprintf_filtered (stream, "{");
705   len = TYPE_NFIELDS (type);
706   n_baseclasses = TYPE_N_BASECLASSES (type);
707
708   /* Print out baseclasses such that we don't print
709      duplicates of virtual baseclasses.  */
710   if (n_baseclasses > 0)
711     pascal_object_print_value (type, valaddr, offset, address,
712                                stream, recurse + 1, val,
713                                options, dont_print_vb);
714
715   if (!len && n_baseclasses == 1)
716     fprintf_filtered (stream, "<No data fields>");
717   else
718     {
719       struct obstack tmp_obstack = dont_print_statmem_obstack;
720       int fields_seen = 0;
721
722       if (dont_print_statmem == 0)
723         {
724           /* If we're at top level, carve out a completely fresh
725              chunk of the obstack and use that until this particular
726              invocation returns.  */
727           obstack_finish (&dont_print_statmem_obstack);
728         }
729
730       for (i = n_baseclasses; i < len; i++)
731         {
732           /* If requested, skip printing of static fields.  */
733           if (!options->pascal_static_field_print
734               && field_is_static (&TYPE_FIELD (type, i)))
735             continue;
736           if (fields_seen)
737             fprintf_filtered (stream, ", ");
738           else if (n_baseclasses > 0)
739             {
740               if (options->pretty)
741                 {
742                   fprintf_filtered (stream, "\n");
743                   print_spaces_filtered (2 + 2 * recurse, stream);
744                   fputs_filtered ("members of ", stream);
745                   fputs_filtered (type_name_no_tag (type), stream);
746                   fputs_filtered (": ", stream);
747                 }
748             }
749           fields_seen = 1;
750
751           if (options->pretty)
752             {
753               fprintf_filtered (stream, "\n");
754               print_spaces_filtered (2 + 2 * recurse, stream);
755             }
756           else
757             {
758               wrap_here (n_spaces (2 + 2 * recurse));
759             }
760           if (options->inspect_it)
761             {
762               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
763                 fputs_filtered ("\"( ptr \"", stream);
764               else
765                 fputs_filtered ("\"( nodef \"", stream);
766               if (field_is_static (&TYPE_FIELD (type, i)))
767                 fputs_filtered ("static ", stream);
768               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
769                                        language_cplus,
770                                        DMGL_PARAMS | DMGL_ANSI);
771               fputs_filtered ("\" \"", stream);
772               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
773                                        language_cplus,
774                                        DMGL_PARAMS | DMGL_ANSI);
775               fputs_filtered ("\") \"", stream);
776             }
777           else
778             {
779               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
780
781               if (field_is_static (&TYPE_FIELD (type, i)))
782                 fputs_filtered ("static ", stream);
783               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
784                                        language_cplus,
785                                        DMGL_PARAMS | DMGL_ANSI);
786               annotate_field_name_end ();
787               fputs_filtered (" = ", stream);
788               annotate_field_value ();
789             }
790
791           if (!field_is_static (&TYPE_FIELD (type, i))
792               && TYPE_FIELD_PACKED (type, i))
793             {
794               struct value *v;
795
796               /* Bitfields require special handling, especially due to byte
797                  order problems.  */
798               if (TYPE_FIELD_IGNORE (type, i))
799                 {
800                   fputs_filtered ("<optimized out or zero length>", stream);
801                 }
802               else if (value_bits_synthetic_pointer (val,
803                                                      TYPE_FIELD_BITPOS (type,
804                                                                         i),
805                                                      TYPE_FIELD_BITSIZE (type,
806                                                                          i)))
807                 {
808                   fputs_filtered (_("<synthetic pointer>"), stream);
809                 }
810               else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
811                                           TYPE_FIELD_BITSIZE (type, i)))
812                 {
813                   val_print_optimized_out (stream);
814                 }
815               else
816                 {
817                   struct value_print_options opts = *options;
818
819                   v = value_from_longest (TYPE_FIELD_TYPE (type, i),
820                                    unpack_field_as_long (type,
821                                                          valaddr + offset, i));
822
823                   opts.deref_ref = 0;
824                   common_val_print (v, stream, recurse + 1, &opts,
825                                     current_language);
826                 }
827             }
828           else
829             {
830               if (TYPE_FIELD_IGNORE (type, i))
831                 {
832                   fputs_filtered ("<optimized out or zero length>", stream);
833                 }
834               else if (field_is_static (&TYPE_FIELD (type, i)))
835                 {
836                   /* struct value *v = value_static_field (type, i);
837                      v4.17 specific.  */
838                   struct value *v;
839
840                   v = value_from_longest
841                     (TYPE_FIELD_TYPE (type, i),
842                      unpack_field_as_long (type, valaddr + offset, i));
843
844                   if (v == NULL)
845                     val_print_optimized_out (stream);
846                   else
847                     pascal_object_print_static_field (v, stream, recurse + 1,
848                                                       options);
849                 }
850               else
851                 {
852                   struct value_print_options opts = *options;
853
854                   opts.deref_ref = 0;
855                   /* val_print (TYPE_FIELD_TYPE (type, i),
856                      valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
857                      address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
858                      stream, format, 0, recurse + 1, pretty); */
859                   val_print (TYPE_FIELD_TYPE (type, i),
860                              valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
861                              address, stream, recurse + 1, val, &opts,
862                              current_language);
863                 }
864             }
865           annotate_field_end ();
866         }
867
868       if (dont_print_statmem == 0)
869         {
870           /* Free the space used to deal with the printing
871              of the members from top level.  */
872           obstack_free (&dont_print_statmem_obstack, last_dont_print);
873           dont_print_statmem_obstack = tmp_obstack;
874         }
875
876       if (options->pretty)
877         {
878           fprintf_filtered (stream, "\n");
879           print_spaces_filtered (2 * recurse, stream);
880         }
881     }
882   fprintf_filtered (stream, "}");
883 }
884
885 /* Special val_print routine to avoid printing multiple copies of virtual
886    baseclasses.  */
887
888 static void
889 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
890                            int offset,
891                            CORE_ADDR address, struct ui_file *stream,
892                            int recurse,
893                            const struct value *val,
894                            const struct value_print_options *options,
895                            struct type **dont_print_vb)
896 {
897   struct type **last_dont_print
898     = (struct type **) obstack_next_free (&dont_print_vb_obstack);
899   struct obstack tmp_obstack = dont_print_vb_obstack;
900   int i, n_baseclasses = TYPE_N_BASECLASSES (type);
901
902   if (dont_print_vb == 0)
903     {
904       /* If we're at top level, carve out a completely fresh
905          chunk of the obstack and use that until this particular
906          invocation returns.  */
907       /* Bump up the high-water mark.  Now alpha is omega.  */
908       obstack_finish (&dont_print_vb_obstack);
909     }
910
911   for (i = 0; i < n_baseclasses; i++)
912     {
913       int boffset;
914       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
915       char *basename = type_name_no_tag (baseclass);
916       const gdb_byte *base_valaddr;
917       int thisoffset;
918
919       if (BASETYPE_VIA_VIRTUAL (type, i))
920         {
921           struct type **first_dont_print
922             = (struct type **) obstack_base (&dont_print_vb_obstack);
923
924           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
925             - first_dont_print;
926
927           while (--j >= 0)
928             if (baseclass == first_dont_print[j])
929               goto flush_it;
930
931           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
932         }
933
934       thisoffset = offset;
935
936       boffset = baseclass_offset (type, i, valaddr + offset, address + offset);
937
938       if (options->pretty)
939         {
940           fprintf_filtered (stream, "\n");
941           print_spaces_filtered (2 * recurse, stream);
942         }
943       fputs_filtered ("<", stream);
944       /* Not sure what the best notation is in the case where there is no
945          baseclass name.  */
946
947       fputs_filtered (basename ? basename : "", stream);
948       fputs_filtered ("> = ", stream);
949
950       /* The virtual base class pointer might have been clobbered by the
951          user program.  Make sure that it still points to a valid memory
952          location.  */
953
954       if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
955         {
956           /* FIXME (alloc): not safe is baseclass is really really big.  */
957           gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
958
959           base_valaddr = buf;
960           if (target_read_memory (address + boffset, buf,
961                                   TYPE_LENGTH (baseclass)) != 0)
962             boffset = -1;
963           address = address + boffset;
964           thisoffset = 0;
965           boffset = 0;
966         }
967       else
968         base_valaddr = valaddr;
969
970       if (boffset == -1)
971         fprintf_filtered (stream, "<invalid address>");
972       else
973         pascal_object_print_value_fields (baseclass, base_valaddr,
974                                           thisoffset + boffset, address,
975                                           stream, recurse, val, options,
976                      (struct type **) obstack_base (&dont_print_vb_obstack),
977                                           0);
978       fputs_filtered (", ", stream);
979
980     flush_it:
981       ;
982     }
983
984   if (dont_print_vb == 0)
985     {
986       /* Free the space used to deal with the printing
987          of this type from top level.  */
988       obstack_free (&dont_print_vb_obstack, last_dont_print);
989       /* Reset watermark so that we can continue protecting
990          ourselves from whatever we were protecting ourselves.  */
991       dont_print_vb_obstack = tmp_obstack;
992     }
993 }
994
995 /* Print value of a static member.
996    To avoid infinite recursion when printing a class that contains
997    a static instance of the class, we keep the addresses of all printed
998    static member classes in an obstack and refuse to print them more
999    than once.
1000
1001    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
1002    have the same meanings as in c_val_print.  */
1003
1004 static void
1005 pascal_object_print_static_field (struct value *val,
1006                                   struct ui_file *stream,
1007                                   int recurse,
1008                                   const struct value_print_options *options)
1009 {
1010   struct type *type = value_type (val);
1011   struct value_print_options opts;
1012
1013   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1014     {
1015       CORE_ADDR *first_dont_print, addr;
1016       int i;
1017
1018       first_dont_print
1019         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1020       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1021         - first_dont_print;
1022
1023       while (--i >= 0)
1024         {
1025           if (value_address (val) == first_dont_print[i])
1026             {
1027               fputs_filtered ("\
1028 <same as static member of an already seen type>",
1029                               stream);
1030               return;
1031             }
1032         }
1033
1034       addr = value_address (val);
1035       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
1036                     sizeof (CORE_ADDR));
1037
1038       CHECK_TYPEDEF (type);
1039       pascal_object_print_value_fields (type,
1040                                         value_contents_for_printing (val),
1041                                         value_embedded_offset (val),
1042                                         addr,
1043                                         stream, recurse,
1044                                         val, options, NULL, 1);
1045       return;
1046     }
1047
1048   opts = *options;
1049   opts.deref_ref = 0;
1050   common_val_print (val, stream, recurse, &opts, current_language);
1051 }
1052
1053 /* -Wmissing-prototypes */
1054 extern initialize_file_ftype _initialize_pascal_valprint;
1055
1056 void
1057 _initialize_pascal_valprint (void)
1058 {
1059   add_setshow_boolean_cmd ("pascal_static-members", class_support,
1060                            &user_print_options.pascal_static_field_print, _("\
1061 Set printing of pascal static members."), _("\
1062 Show printing of pascal static members."), NULL,
1063                            NULL,
1064                            show_pascal_static_field_print,
1065                            &setprintlist, &showprintlist);
1066 }