gdb/
[platform/upstream/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 #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
277               deref_val = coerce_ref_if_computed (original_value);
278               if (deref_val != NULL)
279                 {
280                   /* More complicated computed references are not supported.  */
281                   gdb_assert (embedded_offset == 0);
282                 }
283               else
284                 deref_val = value_at (TYPE_TARGET_TYPE (type),
285                                       unpack_pointer (type,
286                                                       (valaddr
287                                                        + embedded_offset)));
288
289               common_val_print (deref_val, stream, recurse + 1, options,
290                                 current_language);
291             }
292           else
293             fputs_filtered ("???", stream);
294         }
295       break;
296
297     case TYPE_CODE_UNION:
298       if (recurse && !options->unionprint)
299         {
300           fprintf_filtered (stream, "{...}");
301           break;
302         }
303       /* Fall through.  */
304     case TYPE_CODE_STRUCT:
305       if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
306         {
307           /* Print the unmangled name if desired.  */
308           /* Print vtable entry - we only get here if NOT using
309              -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.)  */
310           /* Extract the address, assume that it is unsigned.  */
311           print_address_demangle
312             (gdbarch,
313              extract_unsigned_integer (valaddr + embedded_offset
314                                        + TYPE_FIELD_BITPOS (type,
315                                                             VTBL_FNADDR_OFFSET) / 8,
316                                        TYPE_LENGTH (TYPE_FIELD_TYPE (type,
317                                                                      VTBL_FNADDR_OFFSET)),
318                                        byte_order),
319              stream, demangle);
320         }
321       else
322         {
323           if (is_pascal_string_type (type, &length_pos, &length_size,
324                                      &string_pos, &char_type, NULL))
325             {
326               len = extract_unsigned_integer (valaddr + embedded_offset
327                                               + length_pos, length_size,
328                                               byte_order);
329               LA_PRINT_STRING (stream, char_type,
330                                valaddr + embedded_offset + string_pos,
331                                len, NULL, 0, options);
332             }
333           else
334             pascal_object_print_value_fields (type, valaddr, embedded_offset,
335                                               address, stream, recurse,
336                                               original_value, options,
337                                               NULL, 0);
338         }
339       break;
340
341     case TYPE_CODE_ENUM:
342       if (options->format)
343         {
344           val_print_scalar_formatted (type, valaddr, embedded_offset,
345                                       original_value, options, 0, stream);
346           break;
347         }
348       len = TYPE_NFIELDS (type);
349       val = unpack_long (type, valaddr + embedded_offset);
350       for (i = 0; i < len; i++)
351         {
352           QUIT;
353           if (val == TYPE_FIELD_BITPOS (type, i))
354             {
355               break;
356             }
357         }
358       if (i < len)
359         {
360           fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
361         }
362       else
363         {
364           print_longest (stream, 'd', 0, val);
365         }
366       break;
367
368     case TYPE_CODE_FLAGS:
369       if (options->format)
370         val_print_scalar_formatted (type, valaddr, embedded_offset,
371                                     original_value, options, 0, stream);
372       else
373         val_print_type_code_flags (type, valaddr + embedded_offset, stream);
374       break;
375
376     case TYPE_CODE_FUNC:
377       if (options->format)
378         {
379           val_print_scalar_formatted (type, valaddr, embedded_offset,
380                                       original_value, options, 0, stream);
381           break;
382         }
383       /* FIXME, we should consider, at least for ANSI C language, eliminating
384          the distinction made between FUNCs and POINTERs to FUNCs.  */
385       fprintf_filtered (stream, "{");
386       type_print (type, "", stream, -1);
387       fprintf_filtered (stream, "} ");
388       /* Try to print what function it points to, and its address.  */
389       print_address_demangle (gdbarch, address, stream, demangle);
390       break;
391
392     case TYPE_CODE_BOOL:
393       if (options->format || options->output_format)
394         {
395           struct value_print_options opts = *options;
396
397           opts.format = (options->format ? options->format
398                          : options->output_format);
399           val_print_scalar_formatted (type, valaddr, embedded_offset,
400                                       original_value, &opts, 0, stream);
401         }
402       else
403         {
404           val = unpack_long (type, valaddr + embedded_offset);
405           if (val == 0)
406             fputs_filtered ("false", stream);
407           else if (val == 1)
408             fputs_filtered ("true", stream);
409           else
410             {
411               fputs_filtered ("true (", stream);
412               fprintf_filtered (stream, "%ld)", (long int) val);
413             }
414         }
415       break;
416
417     case TYPE_CODE_RANGE:
418       /* FIXME: create_range_type does not set the unsigned bit in a
419          range type (I think it probably should copy it from the target
420          type), so we won't print values which are too large to
421          fit in a signed integer correctly.  */
422       /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
423          print with the target type, though, because the size of our type
424          and the target type might differ).  */
425       /* FALLTHROUGH */
426
427     case TYPE_CODE_INT:
428       if (options->format || options->output_format)
429         {
430           struct value_print_options opts = *options;
431
432           opts.format = (options->format ? options->format
433                          : options->output_format);
434           val_print_scalar_formatted (type, valaddr, embedded_offset,
435                                       original_value, &opts, 0, stream);
436         }
437       else
438         {
439           val_print_type_code_int (type, valaddr + embedded_offset, stream);
440         }
441       break;
442
443     case TYPE_CODE_CHAR:
444       if (options->format || options->output_format)
445         {
446           struct value_print_options opts = *options;
447
448           opts.format = (options->format ? options->format
449                          : options->output_format);
450           val_print_scalar_formatted (type, valaddr, embedded_offset,
451                                       original_value, &opts, 0, stream);
452         }
453       else
454         {
455           val = unpack_long (type, valaddr + embedded_offset);
456           if (TYPE_UNSIGNED (type))
457             fprintf_filtered (stream, "%u", (unsigned int) val);
458           else
459             fprintf_filtered (stream, "%d", (int) val);
460           fputs_filtered (" ", stream);
461           LA_PRINT_CHAR ((unsigned char) val, type, stream);
462         }
463       break;
464
465     case TYPE_CODE_FLT:
466       if (options->format)
467         {
468           val_print_scalar_formatted (type, valaddr, embedded_offset,
469                                       original_value, options, 0, stream);
470         }
471       else
472         {
473           print_floating (valaddr + embedded_offset, type, stream);
474         }
475       break;
476
477     case TYPE_CODE_BITSTRING:
478     case TYPE_CODE_SET:
479       elttype = TYPE_INDEX_TYPE (type);
480       CHECK_TYPEDEF (elttype);
481       if (TYPE_STUB (elttype))
482         {
483           fprintf_filtered (stream, "<incomplete type>");
484           gdb_flush (stream);
485           break;
486         }
487       else
488         {
489           struct type *range = elttype;
490           LONGEST low_bound, high_bound;
491           int i;
492           int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
493           int need_comma = 0;
494
495           if (is_bitstring)
496             fputs_filtered ("B'", stream);
497           else
498             fputs_filtered ("[", stream);
499
500           i = get_discrete_bounds (range, &low_bound, &high_bound);
501           if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
502             {
503               /* If we know the size of the set type, we can figure out the
504               maximum value.  */
505               i = 0;
506               high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
507               TYPE_HIGH_BOUND (range) = high_bound;
508             }
509         maybe_bad_bstring:
510           if (i < 0)
511             {
512               fputs_filtered ("<error value>", stream);
513               goto done;
514             }
515
516           for (i = low_bound; i <= high_bound; i++)
517             {
518               int element = value_bit_index (type,
519                                              valaddr + embedded_offset, i);
520
521               if (element < 0)
522                 {
523                   i = element;
524                   goto maybe_bad_bstring;
525                 }
526               if (is_bitstring)
527                 fprintf_filtered (stream, "%d", element);
528               else if (element)
529                 {
530                   if (need_comma)
531                     fputs_filtered (", ", stream);
532                   print_type_scalar (range, i, stream);
533                   need_comma = 1;
534
535                   if (i + 1 <= high_bound
536                       && value_bit_index (type,
537                                           valaddr + embedded_offset, ++i))
538                     {
539                       int j = i;
540
541                       fputs_filtered ("..", stream);
542                       while (i + 1 <= high_bound
543                              && value_bit_index (type,
544                                                  valaddr + embedded_offset,
545                                                  ++i))
546                         j = i;
547                       print_type_scalar (range, j, stream);
548                     }
549                 }
550             }
551         done:
552           if (is_bitstring)
553             fputs_filtered ("'", stream);
554           else
555             fputs_filtered ("]", stream);
556         }
557       break;
558
559     case TYPE_CODE_VOID:
560       fprintf_filtered (stream, "void");
561       break;
562
563     case TYPE_CODE_ERROR:
564       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
565       break;
566
567     case TYPE_CODE_UNDEF:
568       /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
569          dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
570          and no complete type for struct foo in that file.  */
571       fprintf_filtered (stream, "<incomplete type>");
572       break;
573
574     default:
575       error (_("Invalid pascal type code %d in symbol table."),
576              TYPE_CODE (type));
577     }
578   gdb_flush (stream);
579   return (0);
580 }
581 \f
582 int
583 pascal_value_print (struct value *val, struct ui_file *stream,
584                     const struct value_print_options *options)
585 {
586   struct type *type = value_type (val);
587   struct value_print_options opts = *options;
588
589   opts.deref_ref = 1;
590
591   /* If it is a pointer, indicate what it points to.
592
593      Print type also if it is a reference.
594
595      Object pascal: if it is a member pointer, we will take care
596      of that when we print it.  */
597   if (TYPE_CODE (type) == TYPE_CODE_PTR
598       || TYPE_CODE (type) == TYPE_CODE_REF)
599     {
600       /* Hack:  remove (char *) for char strings.  Their
601          type is indicated by the quoted string anyway.  */
602       if (TYPE_CODE (type) == TYPE_CODE_PTR
603           && TYPE_NAME (type) == NULL
604           && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
605           && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
606         {
607           /* Print nothing.  */
608         }
609       else
610         {
611           fprintf_filtered (stream, "(");
612           type_print (type, "", stream, -1);
613           fprintf_filtered (stream, ") ");
614         }
615     }
616   return common_val_print (val, stream, 0, &opts, current_language);
617 }
618
619
620 static void
621 show_pascal_static_field_print (struct ui_file *file, int from_tty,
622                                 struct cmd_list_element *c, const char *value)
623 {
624   fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
625                     value);
626 }
627
628 static struct obstack dont_print_vb_obstack;
629 static struct obstack dont_print_statmem_obstack;
630
631 static void pascal_object_print_static_field (struct value *,
632                                               struct ui_file *, int,
633                                               const struct value_print_options *);
634
635 static void pascal_object_print_value (struct type *, const gdb_byte *,
636                                        int,
637                                        CORE_ADDR, struct ui_file *, int,
638                                        const struct value *,
639                                        const struct value_print_options *,
640                                        struct type **);
641
642 /* It was changed to this after 2.4.5.  */
643 const char pascal_vtbl_ptr_name[] =
644 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
645
646 /* Return truth value for assertion that TYPE is of the type
647    "pointer to virtual function".  */
648
649 int
650 pascal_object_is_vtbl_ptr_type (struct type *type)
651 {
652   char *typename = type_name_no_tag (type);
653
654   return (typename != NULL
655           && strcmp (typename, pascal_vtbl_ptr_name) == 0);
656 }
657
658 /* Return truth value for the assertion that TYPE is of the type
659    "pointer to virtual function table".  */
660
661 int
662 pascal_object_is_vtbl_member (struct type *type)
663 {
664   if (TYPE_CODE (type) == TYPE_CODE_PTR)
665     {
666       type = TYPE_TARGET_TYPE (type);
667       if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
668         {
669           type = TYPE_TARGET_TYPE (type);
670           if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* If not using
671                                                            thunks.  */
672               || TYPE_CODE (type) == TYPE_CODE_PTR)     /* If using thunks.  */
673             {
674               /* Virtual functions tables are full of pointers
675                  to virtual functions.  */
676               return pascal_object_is_vtbl_ptr_type (type);
677             }
678         }
679     }
680   return 0;
681 }
682
683 /* Mutually recursive subroutines of pascal_object_print_value and
684    c_val_print to print out a structure's fields:
685    pascal_object_print_value_fields and pascal_object_print_value.
686
687    TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
688    same meanings as in pascal_object_print_value and c_val_print.
689
690    DONT_PRINT is an array of baseclass types that we
691    should not print, or zero if called from top level.  */
692
693 void
694 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
695                                   int offset,
696                                   CORE_ADDR address, struct ui_file *stream,
697                                   int recurse,
698                                   const struct value *val,
699                                   const struct value_print_options *options,
700                                   struct type **dont_print_vb,
701                                   int dont_print_statmem)
702 {
703   int i, len, n_baseclasses;
704   char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
705
706   CHECK_TYPEDEF (type);
707
708   fprintf_filtered (stream, "{");
709   len = TYPE_NFIELDS (type);
710   n_baseclasses = TYPE_N_BASECLASSES (type);
711
712   /* Print out baseclasses such that we don't print
713      duplicates of virtual baseclasses.  */
714   if (n_baseclasses > 0)
715     pascal_object_print_value (type, valaddr, offset, address,
716                                stream, recurse + 1, val,
717                                options, dont_print_vb);
718
719   if (!len && n_baseclasses == 1)
720     fprintf_filtered (stream, "<No data fields>");
721   else
722     {
723       struct obstack tmp_obstack = dont_print_statmem_obstack;
724       int fields_seen = 0;
725
726       if (dont_print_statmem == 0)
727         {
728           /* If we're at top level, carve out a completely fresh
729              chunk of the obstack and use that until this particular
730              invocation returns.  */
731           obstack_finish (&dont_print_statmem_obstack);
732         }
733
734       for (i = n_baseclasses; i < len; i++)
735         {
736           /* If requested, skip printing of static fields.  */
737           if (!options->pascal_static_field_print
738               && field_is_static (&TYPE_FIELD (type, i)))
739             continue;
740           if (fields_seen)
741             fprintf_filtered (stream, ", ");
742           else if (n_baseclasses > 0)
743             {
744               if (options->pretty)
745                 {
746                   fprintf_filtered (stream, "\n");
747                   print_spaces_filtered (2 + 2 * recurse, stream);
748                   fputs_filtered ("members of ", stream);
749                   fputs_filtered (type_name_no_tag (type), stream);
750                   fputs_filtered (": ", stream);
751                 }
752             }
753           fields_seen = 1;
754
755           if (options->pretty)
756             {
757               fprintf_filtered (stream, "\n");
758               print_spaces_filtered (2 + 2 * recurse, stream);
759             }
760           else
761             {
762               wrap_here (n_spaces (2 + 2 * recurse));
763             }
764           if (options->inspect_it)
765             {
766               if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
767                 fputs_filtered ("\"( ptr \"", stream);
768               else
769                 fputs_filtered ("\"( nodef \"", stream);
770               if (field_is_static (&TYPE_FIELD (type, i)))
771                 fputs_filtered ("static ", stream);
772               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
773                                        language_cplus,
774                                        DMGL_PARAMS | DMGL_ANSI);
775               fputs_filtered ("\" \"", stream);
776               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
777                                        language_cplus,
778                                        DMGL_PARAMS | DMGL_ANSI);
779               fputs_filtered ("\") \"", stream);
780             }
781           else
782             {
783               annotate_field_begin (TYPE_FIELD_TYPE (type, i));
784
785               if (field_is_static (&TYPE_FIELD (type, i)))
786                 fputs_filtered ("static ", stream);
787               fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
788                                        language_cplus,
789                                        DMGL_PARAMS | DMGL_ANSI);
790               annotate_field_name_end ();
791               fputs_filtered (" = ", stream);
792               annotate_field_value ();
793             }
794
795           if (!field_is_static (&TYPE_FIELD (type, i))
796               && TYPE_FIELD_PACKED (type, i))
797             {
798               struct value *v;
799
800               /* Bitfields require special handling, especially due to byte
801                  order problems.  */
802               if (TYPE_FIELD_IGNORE (type, i))
803                 {
804                   fputs_filtered ("<optimized out or zero length>", stream);
805                 }
806               else if (value_bits_synthetic_pointer (val,
807                                                      TYPE_FIELD_BITPOS (type,
808                                                                         i),
809                                                      TYPE_FIELD_BITSIZE (type,
810                                                                          i)))
811                 {
812                   fputs_filtered (_("<synthetic pointer>"), stream);
813                 }
814               else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
815                                           TYPE_FIELD_BITSIZE (type, i)))
816                 {
817                   val_print_optimized_out (stream);
818                 }
819               else
820                 {
821                   struct value_print_options opts = *options;
822
823                   v = value_field_bitfield (type, i, valaddr, offset, val);
824
825                   opts.deref_ref = 0;
826                   common_val_print (v, stream, recurse + 1, &opts,
827                                     current_language);
828                 }
829             }
830           else
831             {
832               if (TYPE_FIELD_IGNORE (type, i))
833                 {
834                   fputs_filtered ("<optimized out or zero length>", stream);
835                 }
836               else if (field_is_static (&TYPE_FIELD (type, i)))
837                 {
838                   /* struct value *v = value_static_field (type, i);
839                      v4.17 specific.  */
840                   struct value *v;
841
842                   v = value_field_bitfield (type, i, valaddr, offset, val);
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 = 0;
914       struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
915       char *basename = type_name_no_tag (baseclass);
916       const gdb_byte *base_valaddr = NULL;
917       int thisoffset;
918       volatile struct gdb_exception ex;
919       int skip = 0;
920
921       if (BASETYPE_VIA_VIRTUAL (type, i))
922         {
923           struct type **first_dont_print
924             = (struct type **) obstack_base (&dont_print_vb_obstack);
925
926           int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
927             - first_dont_print;
928
929           while (--j >= 0)
930             if (baseclass == first_dont_print[j])
931               goto flush_it;
932
933           obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
934         }
935
936       thisoffset = offset;
937
938       TRY_CATCH (ex, RETURN_MASK_ERROR)
939         {
940           boffset = baseclass_offset (type, i, valaddr, offset, address, val);
941         }
942       if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR)
943         skip = -1;
944       else if (ex.reason < 0)
945         skip = 1;
946       else
947         {
948           skip = 0;
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 < 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                 skip = 1;
963               address = address + boffset;
964               thisoffset = 0;
965               boffset = 0;
966             }
967           else
968             base_valaddr = valaddr;
969         }
970
971       if (options->pretty)
972         {
973           fprintf_filtered (stream, "\n");
974           print_spaces_filtered (2 * recurse, stream);
975         }
976       fputs_filtered ("<", stream);
977       /* Not sure what the best notation is in the case where there is no
978          baseclass name.  */
979
980       fputs_filtered (basename ? basename : "", stream);
981       fputs_filtered ("> = ", stream);
982
983       if (skip < 0)
984         val_print_unavailable (stream);
985       else if (skip > 0)
986         val_print_invalid_address (stream);
987       else
988         pascal_object_print_value_fields (baseclass, base_valaddr,
989                                           thisoffset + boffset, address,
990                                           stream, recurse, val, options,
991                      (struct type **) obstack_base (&dont_print_vb_obstack),
992                                           0);
993       fputs_filtered (", ", stream);
994
995     flush_it:
996       ;
997     }
998
999   if (dont_print_vb == 0)
1000     {
1001       /* Free the space used to deal with the printing
1002          of this type from top level.  */
1003       obstack_free (&dont_print_vb_obstack, last_dont_print);
1004       /* Reset watermark so that we can continue protecting
1005          ourselves from whatever we were protecting ourselves.  */
1006       dont_print_vb_obstack = tmp_obstack;
1007     }
1008 }
1009
1010 /* Print value of a static member.
1011    To avoid infinite recursion when printing a class that contains
1012    a static instance of the class, we keep the addresses of all printed
1013    static member classes in an obstack and refuse to print them more
1014    than once.
1015
1016    VAL contains the value to print, STREAM, RECURSE, and OPTIONS
1017    have the same meanings as in c_val_print.  */
1018
1019 static void
1020 pascal_object_print_static_field (struct value *val,
1021                                   struct ui_file *stream,
1022                                   int recurse,
1023                                   const struct value_print_options *options)
1024 {
1025   struct type *type = value_type (val);
1026   struct value_print_options opts;
1027
1028   if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1029     {
1030       CORE_ADDR *first_dont_print, addr;
1031       int i;
1032
1033       first_dont_print
1034         = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1035       i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1036         - first_dont_print;
1037
1038       while (--i >= 0)
1039         {
1040           if (value_address (val) == first_dont_print[i])
1041             {
1042               fputs_filtered ("\
1043 <same as static member of an already seen type>",
1044                               stream);
1045               return;
1046             }
1047         }
1048
1049       addr = value_address (val);
1050       obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
1051                     sizeof (CORE_ADDR));
1052
1053       CHECK_TYPEDEF (type);
1054       pascal_object_print_value_fields (type,
1055                                         value_contents_for_printing (val),
1056                                         value_embedded_offset (val),
1057                                         addr,
1058                                         stream, recurse,
1059                                         val, options, NULL, 1);
1060       return;
1061     }
1062
1063   opts = *options;
1064   opts.deref_ref = 0;
1065   common_val_print (val, stream, recurse, &opts, current_language);
1066 }
1067
1068 /* -Wmissing-prototypes */
1069 extern initialize_file_ftype _initialize_pascal_valprint;
1070
1071 void
1072 _initialize_pascal_valprint (void)
1073 {
1074   add_setshow_boolean_cmd ("pascal_static-members", class_support,
1075                            &user_print_options.pascal_static_field_print, _("\
1076 Set printing of pascal static members."), _("\
1077 Show printing of pascal static members."), NULL,
1078                            NULL,
1079                            show_pascal_static_field_print,
1080                            &setprintlist, &showprintlist);
1081 }