1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
6 This file is part of GDB.
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.
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.
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/>. */
21 /* This file is derived from c-valprint.c */
24 #include "gdb_obstack.h"
27 #include "expression.h"
34 #include "typeprint.h"
40 #include "cp-support.h"
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.
49 If the data are a string pointer, returns the number of string characters
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_print_options *options)
59 struct gdbarch *gdbarch = get_type_arch (type);
60 enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
61 unsigned int i = 0; /* Number of characters printed */
65 int length_pos, length_size, string_pos;
66 struct type *char_type;
71 switch (TYPE_CODE (type))
74 if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
76 elttype = check_typedef (TYPE_TARGET_TYPE (type));
77 eltlen = TYPE_LENGTH (elttype);
78 len = TYPE_LENGTH (type) / eltlen;
79 if (options->prettyprint_arrays)
81 print_spaces_filtered (2 + 2 * recurse, stream);
83 /* If 's' format is used, try to print out as string.
84 If no format is given, print as string if element type
85 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
86 if (options->format == 's'
87 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
88 && TYPE_CODE (elttype) == TYPE_CODE_CHAR
89 && options->format == 0))
91 /* If requested, look for the first null char and only print
93 if (options->stop_print_at_null)
95 unsigned int temp_len;
97 /* Look for a NULL char. */
99 extract_unsigned_integer (valaddr + embedded_offset +
100 temp_len * eltlen, eltlen,
102 && temp_len < len && temp_len < options->print_max;
107 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
108 valaddr + embedded_offset, len, NULL, 0,
114 fprintf_filtered (stream, "{");
115 /* If this is a virtual function table, print the 0th
116 entry specially, and the rest of the members normally. */
117 if (pascal_object_is_vtbl_ptr_type (elttype))
120 fprintf_filtered (stream, "%d vtable entries", len - 1);
126 val_print_array_elements (type, valaddr + embedded_offset, address, stream,
127 recurse, options, i);
128 fprintf_filtered (stream, "}");
132 /* Array of unspecified length: treat like pointer to first elt. */
134 goto print_unpacked_pointer;
137 if (options->format && options->format != 's')
139 print_scalar_formatted (valaddr + embedded_offset, type,
143 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
145 /* Print the unmangled name if desired. */
146 /* Print vtable entry - we only get here if we ARE using
147 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
148 /* Extract the address, assume that it is unsigned. */
149 addr = extract_unsigned_integer (valaddr + embedded_offset,
150 TYPE_LENGTH (type), byte_order);
151 print_address_demangle (gdbarch, addr, stream, demangle);
154 elttype = check_typedef (TYPE_TARGET_TYPE (type));
156 addr = unpack_pointer (type, valaddr + embedded_offset);
157 print_unpacked_pointer:
158 elttype = check_typedef (TYPE_TARGET_TYPE (type));
160 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
162 /* Try to print what function it points to. */
163 print_address_demangle (gdbarch, addr, stream, demangle);
164 /* Return value is irrelevant except for string pointers. */
168 if (options->addressprint && options->format != 's')
170 fputs_filtered (paddress (gdbarch, addr), stream);
173 /* For a pointer to char or unsigned char, also print the string
174 pointed to, unless pointer is null. */
175 if (((TYPE_LENGTH (elttype) == 1
176 && (TYPE_CODE (elttype) == TYPE_CODE_INT
177 || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
178 || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
179 && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
180 && (options->format == 0 || options->format == 's')
183 /* no wide string yet */
184 i = val_print_string (elttype, addr, -1, stream, options);
186 /* also for pointers to pascal strings */
187 /* Note: this is Free Pascal specific:
188 as GDB does not recognize stabs pascal strings
189 Pascal strings are mapped to records
190 with lowercase names PM */
191 if (is_pascal_string_type (elttype, &length_pos, &length_size,
192 &string_pos, &char_type, NULL)
195 ULONGEST string_length;
197 buffer = xmalloc (length_size);
198 read_memory (addr + length_pos, buffer, length_size);
199 string_length = extract_unsigned_integer (buffer, length_size,
202 i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
204 else if (pascal_object_is_vtbl_member (type))
206 /* print vtbl's nicely */
207 CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
209 struct minimal_symbol *msymbol =
210 lookup_minimal_symbol_by_pc (vt_address);
211 if ((msymbol != NULL)
212 && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
214 fputs_filtered (" <", stream);
215 fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
216 fputs_filtered (">", stream);
218 if (vt_address && options->vtblprint)
220 struct value *vt_val;
221 struct symbol *wsym = (struct symbol *) NULL;
223 struct block *block = (struct block *) NULL;
227 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
228 VAR_DOMAIN, &is_this_fld);
232 wtype = SYMBOL_TYPE (wsym);
236 wtype = TYPE_TARGET_TYPE (type);
238 vt_val = value_at (wtype, vt_address);
239 common_val_print (vt_val, stream, recurse + 1, options,
243 fprintf_filtered (stream, "\n");
244 print_spaces_filtered (2 + 2 * recurse, stream);
249 /* Return number of characters printed, including the terminating
250 '\0' if we reached the end. val_print_string takes care including
251 the terminating '\0' if necessary. */
257 elttype = check_typedef (TYPE_TARGET_TYPE (type));
258 if (options->addressprint)
261 = extract_typed_address (valaddr + embedded_offset, type);
262 fprintf_filtered (stream, "@");
263 fputs_filtered (paddress (gdbarch, addr), stream);
264 if (options->deref_ref)
265 fputs_filtered (": ", stream);
267 /* De-reference the reference. */
268 if (options->deref_ref)
270 if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
272 struct value *deref_val =
274 (TYPE_TARGET_TYPE (type),
275 unpack_pointer (type, valaddr + embedded_offset));
276 common_val_print (deref_val, stream, recurse + 1, options,
280 fputs_filtered ("???", stream);
284 case TYPE_CODE_UNION:
285 if (recurse && !options->unionprint)
287 fprintf_filtered (stream, "{...}");
291 case TYPE_CODE_STRUCT:
292 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
294 /* Print the unmangled name if desired. */
295 /* Print vtable entry - we only get here if NOT using
296 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
297 /* Extract the address, assume that it is unsigned. */
298 print_address_demangle
300 extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
301 TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET)), byte_order),
306 if (is_pascal_string_type (type, &length_pos, &length_size,
307 &string_pos, &char_type, NULL))
309 len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size, byte_order);
310 LA_PRINT_STRING (stream, char_type,
311 valaddr + embedded_offset + string_pos,
312 len, NULL, 0, options);
315 pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream,
316 recurse, options, NULL, 0);
323 print_scalar_formatted (valaddr + embedded_offset, type,
327 len = TYPE_NFIELDS (type);
328 val = unpack_long (type, valaddr + embedded_offset);
329 for (i = 0; i < len; i++)
332 if (val == TYPE_FIELD_BITPOS (type, i))
339 fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
343 print_longest (stream, 'd', 0, val);
347 case TYPE_CODE_FLAGS:
349 print_scalar_formatted (valaddr + embedded_offset, type,
352 val_print_type_code_flags (type, valaddr + embedded_offset, stream);
358 print_scalar_formatted (valaddr + embedded_offset, type,
362 /* FIXME, we should consider, at least for ANSI C language, eliminating
363 the distinction made between FUNCs and POINTERs to FUNCs. */
364 fprintf_filtered (stream, "{");
365 type_print (type, "", stream, -1);
366 fprintf_filtered (stream, "} ");
367 /* Try to print what function it points to, and its address. */
368 print_address_demangle (gdbarch, address, stream, demangle);
372 if (options->format || options->output_format)
374 struct value_print_options opts = *options;
375 opts.format = (options->format ? options->format
376 : options->output_format);
377 print_scalar_formatted (valaddr + embedded_offset, type,
382 val = unpack_long (type, valaddr + embedded_offset);
384 fputs_filtered ("false", stream);
386 fputs_filtered ("true", stream);
389 fputs_filtered ("true (", stream);
390 fprintf_filtered (stream, "%ld)", (long int) val);
395 case TYPE_CODE_RANGE:
396 /* FIXME: create_range_type does not set the unsigned bit in a
397 range type (I think it probably should copy it from the target
398 type), so we won't print values which are too large to
399 fit in a signed integer correctly. */
400 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
401 print with the target type, though, because the size of our type
402 and the target type might differ). */
406 if (options->format || options->output_format)
408 struct value_print_options opts = *options;
409 opts.format = (options->format ? options->format
410 : options->output_format);
411 print_scalar_formatted (valaddr + embedded_offset, type,
416 val_print_type_code_int (type, valaddr + embedded_offset, stream);
421 if (options->format || options->output_format)
423 struct value_print_options opts = *options;
424 opts.format = (options->format ? options->format
425 : options->output_format);
426 print_scalar_formatted (valaddr + embedded_offset, type,
431 val = unpack_long (type, valaddr + embedded_offset);
432 if (TYPE_UNSIGNED (type))
433 fprintf_filtered (stream, "%u", (unsigned int) val);
435 fprintf_filtered (stream, "%d", (int) val);
436 fputs_filtered (" ", stream);
437 LA_PRINT_CHAR ((unsigned char) val, type, stream);
444 print_scalar_formatted (valaddr + embedded_offset, type,
449 print_floating (valaddr + embedded_offset, type, stream);
453 case TYPE_CODE_BITSTRING:
455 elttype = TYPE_INDEX_TYPE (type);
456 CHECK_TYPEDEF (elttype);
457 if (TYPE_STUB (elttype))
459 fprintf_filtered (stream, "<incomplete type>");
465 struct type *range = elttype;
466 LONGEST low_bound, high_bound;
468 int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
472 fputs_filtered ("B'", stream);
474 fputs_filtered ("[", stream);
476 i = get_discrete_bounds (range, &low_bound, &high_bound);
480 fputs_filtered ("<error value>", stream);
484 for (i = low_bound; i <= high_bound; i++)
486 int element = value_bit_index (type, valaddr + embedded_offset, i);
490 goto maybe_bad_bstring;
493 fprintf_filtered (stream, "%d", element);
497 fputs_filtered (", ", stream);
498 print_type_scalar (range, i, stream);
501 if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
504 fputs_filtered ("..", stream);
505 while (i + 1 <= high_bound
506 && value_bit_index (type, valaddr + embedded_offset, ++i))
508 print_type_scalar (range, j, stream);
514 fputs_filtered ("'", stream);
516 fputs_filtered ("]", stream);
521 fprintf_filtered (stream, "void");
524 case TYPE_CODE_ERROR:
525 fprintf_filtered (stream, "<error type>");
528 case TYPE_CODE_UNDEF:
529 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
530 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
531 and no complete type for struct foo in that file. */
532 fprintf_filtered (stream, "<incomplete type>");
536 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
543 pascal_value_print (struct value *val, struct ui_file *stream,
544 const struct value_print_options *options)
546 struct type *type = value_type (val);
548 /* If it is a pointer, indicate what it points to.
550 Print type also if it is a reference.
552 Object pascal: if it is a member pointer, we will take care
553 of that when we print it. */
554 if (TYPE_CODE (type) == TYPE_CODE_PTR
555 || TYPE_CODE (type) == TYPE_CODE_REF)
557 /* Hack: remove (char *) for char strings. Their
558 type is indicated by the quoted string anyway. */
559 if (TYPE_CODE (type) == TYPE_CODE_PTR
560 && TYPE_NAME (type) == NULL
561 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
562 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
568 fprintf_filtered (stream, "(");
569 type_print (type, "", stream, -1);
570 fprintf_filtered (stream, ") ");
573 return common_val_print (val, stream, 0, options, current_language);
578 show_pascal_static_field_print (struct ui_file *file, int from_tty,
579 struct cmd_list_element *c, const char *value)
581 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
585 static struct obstack dont_print_vb_obstack;
586 static struct obstack dont_print_statmem_obstack;
588 static void pascal_object_print_static_field (struct value *,
589 struct ui_file *, int,
590 const struct value_print_options *);
592 static void pascal_object_print_value (struct type *, const gdb_byte *,
593 CORE_ADDR, struct ui_file *, int,
594 const struct value_print_options *,
597 /* It was changed to this after 2.4.5. */
598 const char pascal_vtbl_ptr_name[] =
599 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
601 /* Return truth value for assertion that TYPE is of the type
602 "pointer to virtual function". */
605 pascal_object_is_vtbl_ptr_type (struct type *type)
607 char *typename = type_name_no_tag (type);
609 return (typename != NULL
610 && strcmp (typename, pascal_vtbl_ptr_name) == 0);
613 /* Return truth value for the assertion that TYPE is of the type
614 "pointer to virtual function table". */
617 pascal_object_is_vtbl_member (struct type *type)
619 if (TYPE_CODE (type) == TYPE_CODE_PTR)
621 type = TYPE_TARGET_TYPE (type);
622 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
624 type = TYPE_TARGET_TYPE (type);
625 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* if not using thunks */
626 || TYPE_CODE (type) == TYPE_CODE_PTR) /* if using thunks */
628 /* Virtual functions tables are full of pointers
629 to virtual functions. */
630 return pascal_object_is_vtbl_ptr_type (type);
637 /* Mutually recursive subroutines of pascal_object_print_value and
638 c_val_print to print out a structure's fields:
639 pascal_object_print_value_fields and pascal_object_print_value.
641 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
642 same meanings as in pascal_object_print_value and c_val_print.
644 DONT_PRINT is an array of baseclass types that we
645 should not print, or zero if called from top level. */
648 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
649 CORE_ADDR address, struct ui_file *stream,
651 const struct value_print_options *options,
652 struct type **dont_print_vb,
653 int dont_print_statmem)
655 int i, len, n_baseclasses;
656 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
658 CHECK_TYPEDEF (type);
660 fprintf_filtered (stream, "{");
661 len = TYPE_NFIELDS (type);
662 n_baseclasses = TYPE_N_BASECLASSES (type);
664 /* Print out baseclasses such that we don't print
665 duplicates of virtual baseclasses. */
666 if (n_baseclasses > 0)
667 pascal_object_print_value (type, valaddr, address, stream,
668 recurse + 1, options, dont_print_vb);
670 if (!len && n_baseclasses == 1)
671 fprintf_filtered (stream, "<No data fields>");
674 struct obstack tmp_obstack = dont_print_statmem_obstack;
677 if (dont_print_statmem == 0)
679 /* If we're at top level, carve out a completely fresh
680 chunk of the obstack and use that until this particular
681 invocation returns. */
682 obstack_finish (&dont_print_statmem_obstack);
685 for (i = n_baseclasses; i < len; i++)
687 /* If requested, skip printing of static fields. */
688 if (!options->pascal_static_field_print
689 && field_is_static (&TYPE_FIELD (type, i)))
692 fprintf_filtered (stream, ", ");
693 else if (n_baseclasses > 0)
697 fprintf_filtered (stream, "\n");
698 print_spaces_filtered (2 + 2 * recurse, stream);
699 fputs_filtered ("members of ", stream);
700 fputs_filtered (type_name_no_tag (type), stream);
701 fputs_filtered (": ", stream);
708 fprintf_filtered (stream, "\n");
709 print_spaces_filtered (2 + 2 * recurse, stream);
713 wrap_here (n_spaces (2 + 2 * recurse));
715 if (options->inspect_it)
717 if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
718 fputs_filtered ("\"( ptr \"", stream);
720 fputs_filtered ("\"( nodef \"", stream);
721 if (field_is_static (&TYPE_FIELD (type, i)))
722 fputs_filtered ("static ", stream);
723 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
725 DMGL_PARAMS | DMGL_ANSI);
726 fputs_filtered ("\" \"", stream);
727 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
729 DMGL_PARAMS | DMGL_ANSI);
730 fputs_filtered ("\") \"", stream);
734 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
736 if (field_is_static (&TYPE_FIELD (type, i)))
737 fputs_filtered ("static ", stream);
738 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
740 DMGL_PARAMS | DMGL_ANSI);
741 annotate_field_name_end ();
742 fputs_filtered (" = ", stream);
743 annotate_field_value ();
746 if (!field_is_static (&TYPE_FIELD (type, i))
747 && TYPE_FIELD_PACKED (type, i))
751 /* Bitfields require special handling, especially due to byte
753 if (TYPE_FIELD_IGNORE (type, i))
755 fputs_filtered ("<optimized out or zero length>", stream);
759 struct value_print_options opts = *options;
760 v = value_from_longest (TYPE_FIELD_TYPE (type, i),
761 unpack_field_as_long (type, valaddr, i));
764 common_val_print (v, stream, recurse + 1, &opts,
770 if (TYPE_FIELD_IGNORE (type, i))
772 fputs_filtered ("<optimized out or zero length>", stream);
774 else if (field_is_static (&TYPE_FIELD (type, i)))
776 /* struct value *v = value_static_field (type, i); v4.17 specific */
778 v = value_from_longest (TYPE_FIELD_TYPE (type, i),
779 unpack_field_as_long (type, valaddr, i));
782 fputs_filtered ("<optimized out>", stream);
784 pascal_object_print_static_field (v, stream, recurse + 1,
789 struct value_print_options opts = *options;
791 /* val_print (TYPE_FIELD_TYPE (type, i),
792 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
793 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
794 stream, format, 0, recurse + 1, pretty); */
795 val_print (TYPE_FIELD_TYPE (type, i),
796 valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
797 address + TYPE_FIELD_BITPOS (type, i) / 8,
798 stream, recurse + 1, &opts,
802 annotate_field_end ();
805 if (dont_print_statmem == 0)
807 /* Free the space used to deal with the printing
808 of the members from top level. */
809 obstack_free (&dont_print_statmem_obstack, last_dont_print);
810 dont_print_statmem_obstack = tmp_obstack;
815 fprintf_filtered (stream, "\n");
816 print_spaces_filtered (2 * recurse, stream);
819 fprintf_filtered (stream, "}");
822 /* Special val_print routine to avoid printing multiple copies of virtual
826 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
827 CORE_ADDR address, struct ui_file *stream,
829 const struct value_print_options *options,
830 struct type **dont_print_vb)
832 struct type **last_dont_print
833 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
834 struct obstack tmp_obstack = dont_print_vb_obstack;
835 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
837 if (dont_print_vb == 0)
839 /* If we're at top level, carve out a completely fresh
840 chunk of the obstack and use that until this particular
841 invocation returns. */
842 /* Bump up the high-water mark. Now alpha is omega. */
843 obstack_finish (&dont_print_vb_obstack);
846 for (i = 0; i < n_baseclasses; i++)
849 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
850 char *basename = type_name_no_tag (baseclass);
851 const gdb_byte *base_valaddr;
853 if (BASETYPE_VIA_VIRTUAL (type, i))
855 struct type **first_dont_print
856 = (struct type **) obstack_base (&dont_print_vb_obstack);
858 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
862 if (baseclass == first_dont_print[j])
865 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
868 boffset = baseclass_offset (type, i, valaddr, address);
872 fprintf_filtered (stream, "\n");
873 print_spaces_filtered (2 * recurse, stream);
875 fputs_filtered ("<", stream);
876 /* Not sure what the best notation is in the case where there is no
879 fputs_filtered (basename ? basename : "", stream);
880 fputs_filtered ("> = ", stream);
882 /* The virtual base class pointer might have been clobbered by the
883 user program. Make sure that it still points to a valid memory
886 if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
888 /* FIXME (alloc): not safe is baseclass is really really big. */
889 gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
891 if (target_read_memory (address + boffset, buf,
892 TYPE_LENGTH (baseclass)) != 0)
896 base_valaddr = valaddr + boffset;
899 fprintf_filtered (stream, "<invalid address>");
901 pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
902 stream, recurse, options,
903 (struct type **) obstack_base (&dont_print_vb_obstack),
905 fputs_filtered (", ", stream);
911 if (dont_print_vb == 0)
913 /* Free the space used to deal with the printing
914 of this type from top level. */
915 obstack_free (&dont_print_vb_obstack, last_dont_print);
916 /* Reset watermark so that we can continue protecting
917 ourselves from whatever we were protecting ourselves. */
918 dont_print_vb_obstack = tmp_obstack;
922 /* Print value of a static member.
923 To avoid infinite recursion when printing a class that contains
924 a static instance of the class, we keep the addresses of all printed
925 static member classes in an obstack and refuse to print them more
928 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
929 have the same meanings as in c_val_print. */
932 pascal_object_print_static_field (struct value *val,
933 struct ui_file *stream,
935 const struct value_print_options *options)
937 struct type *type = value_type (val);
938 struct value_print_options opts;
940 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
942 CORE_ADDR *first_dont_print, addr;
946 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
947 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
952 if (value_address (val) == first_dont_print[i])
954 fputs_filtered ("<same as static member of an already seen type>",
960 addr = value_address (val);
961 obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
964 CHECK_TYPEDEF (type);
965 pascal_object_print_value_fields (type, value_contents (val), addr,
966 stream, recurse, options, NULL, 1);
972 common_val_print (val, stream, recurse, &opts, current_language);
975 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
978 _initialize_pascal_valprint (void)
980 add_setshow_boolean_cmd ("pascal_static-members", class_support,
981 &user_print_options.pascal_static_field_print, _("\
982 Set printing of pascal static members."), _("\
983 Show printing of pascal static members."), NULL,
985 show_pascal_static_field_print,
986 &setprintlist, &showprintlist);