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