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;
198 buffer = xmalloc (length_size);
199 read_memory (addr + length_pos, buffer, length_size);
200 string_length = extract_unsigned_integer (buffer, length_size,
203 i = val_print_string (char_type ,addr + string_pos, string_length, stream, options);
205 else if (pascal_object_is_vtbl_member (type))
207 /* print vtbl's nicely */
208 CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
209 struct minimal_symbol *msymbol =
210 lookup_minimal_symbol_by_pc (vt_address);
212 if ((msymbol != NULL)
213 && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
215 fputs_filtered (" <", stream);
216 fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
217 fputs_filtered (">", stream);
219 if (vt_address && options->vtblprint)
221 struct value *vt_val;
222 struct symbol *wsym = (struct symbol *) NULL;
224 struct block *block = (struct block *) NULL;
228 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
229 VAR_DOMAIN, &is_this_fld);
233 wtype = SYMBOL_TYPE (wsym);
237 wtype = TYPE_TARGET_TYPE (type);
239 vt_val = value_at (wtype, vt_address);
240 common_val_print (vt_val, stream, recurse + 1, options,
244 fprintf_filtered (stream, "\n");
245 print_spaces_filtered (2 + 2 * recurse, stream);
250 /* Return number of characters printed, including the terminating
251 '\0' if we reached the end. val_print_string takes care including
252 the terminating '\0' if necessary. */
258 elttype = check_typedef (TYPE_TARGET_TYPE (type));
259 if (options->addressprint)
262 = extract_typed_address (valaddr + embedded_offset, type);
264 fprintf_filtered (stream, "@");
265 fputs_filtered (paddress (gdbarch, addr), stream);
266 if (options->deref_ref)
267 fputs_filtered (": ", stream);
269 /* De-reference the reference. */
270 if (options->deref_ref)
272 if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
274 struct value *deref_val =
276 (TYPE_TARGET_TYPE (type),
277 unpack_pointer (type, valaddr + embedded_offset));
279 common_val_print (deref_val, stream, recurse + 1, options,
283 fputs_filtered ("???", stream);
287 case TYPE_CODE_UNION:
288 if (recurse && !options->unionprint)
290 fprintf_filtered (stream, "{...}");
294 case TYPE_CODE_STRUCT:
295 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
297 /* Print the unmangled name if desired. */
298 /* Print vtable entry - we only get here if NOT using
299 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
300 /* Extract the address, assume that it is unsigned. */
301 print_address_demangle
303 extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
304 TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET)), byte_order),
309 if (is_pascal_string_type (type, &length_pos, &length_size,
310 &string_pos, &char_type, NULL))
312 len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size, byte_order);
313 LA_PRINT_STRING (stream, char_type,
314 valaddr + embedded_offset + string_pos,
315 len, NULL, 0, options);
318 pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream,
319 recurse, options, NULL, 0);
326 print_scalar_formatted (valaddr + embedded_offset, type,
330 len = TYPE_NFIELDS (type);
331 val = unpack_long (type, valaddr + embedded_offset);
332 for (i = 0; i < len; i++)
335 if (val == TYPE_FIELD_BITPOS (type, i))
342 fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
346 print_longest (stream, 'd', 0, val);
350 case TYPE_CODE_FLAGS:
352 print_scalar_formatted (valaddr + embedded_offset, type,
355 val_print_type_code_flags (type, valaddr + embedded_offset, stream);
361 print_scalar_formatted (valaddr + embedded_offset, type,
365 /* FIXME, we should consider, at least for ANSI C language, eliminating
366 the distinction made between FUNCs and POINTERs to FUNCs. */
367 fprintf_filtered (stream, "{");
368 type_print (type, "", stream, -1);
369 fprintf_filtered (stream, "} ");
370 /* Try to print what function it points to, and its address. */
371 print_address_demangle (gdbarch, address, stream, demangle);
375 if (options->format || options->output_format)
377 struct value_print_options opts = *options;
379 opts.format = (options->format ? options->format
380 : options->output_format);
381 print_scalar_formatted (valaddr + embedded_offset, type,
386 val = unpack_long (type, valaddr + embedded_offset);
388 fputs_filtered ("false", stream);
390 fputs_filtered ("true", stream);
393 fputs_filtered ("true (", stream);
394 fprintf_filtered (stream, "%ld)", (long int) val);
399 case TYPE_CODE_RANGE:
400 /* FIXME: create_range_type does not set the unsigned bit in a
401 range type (I think it probably should copy it from the target
402 type), so we won't print values which are too large to
403 fit in a signed integer correctly. */
404 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
405 print with the target type, though, because the size of our type
406 and the target type might differ). */
410 if (options->format || options->output_format)
412 struct value_print_options opts = *options;
414 opts.format = (options->format ? options->format
415 : options->output_format);
416 print_scalar_formatted (valaddr + embedded_offset, type,
421 val_print_type_code_int (type, valaddr + embedded_offset, stream);
426 if (options->format || options->output_format)
428 struct value_print_options opts = *options;
430 opts.format = (options->format ? options->format
431 : options->output_format);
432 print_scalar_formatted (valaddr + embedded_offset, type,
437 val = unpack_long (type, valaddr + embedded_offset);
438 if (TYPE_UNSIGNED (type))
439 fprintf_filtered (stream, "%u", (unsigned int) val);
441 fprintf_filtered (stream, "%d", (int) val);
442 fputs_filtered (" ", stream);
443 LA_PRINT_CHAR ((unsigned char) val, type, stream);
450 print_scalar_formatted (valaddr + embedded_offset, type,
455 print_floating (valaddr + embedded_offset, type, stream);
459 case TYPE_CODE_BITSTRING:
461 elttype = TYPE_INDEX_TYPE (type);
462 CHECK_TYPEDEF (elttype);
463 if (TYPE_STUB (elttype))
465 fprintf_filtered (stream, "<incomplete type>");
471 struct type *range = elttype;
472 LONGEST low_bound, high_bound;
474 int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
478 fputs_filtered ("B'", stream);
480 fputs_filtered ("[", stream);
482 i = get_discrete_bounds (range, &low_bound, &high_bound);
483 if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
485 /* If we know the size of the set type, we can figure out the
488 high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
489 TYPE_HIGH_BOUND (range) = high_bound;
494 fputs_filtered ("<error value>", stream);
498 for (i = low_bound; i <= high_bound; i++)
500 int element = value_bit_index (type, valaddr + embedded_offset, i);
505 goto maybe_bad_bstring;
508 fprintf_filtered (stream, "%d", element);
512 fputs_filtered (", ", stream);
513 print_type_scalar (range, i, stream);
516 if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
520 fputs_filtered ("..", stream);
521 while (i + 1 <= high_bound
522 && value_bit_index (type, valaddr + embedded_offset, ++i))
524 print_type_scalar (range, j, stream);
530 fputs_filtered ("'", stream);
532 fputs_filtered ("]", stream);
537 fprintf_filtered (stream, "void");
540 case TYPE_CODE_ERROR:
541 fprintf_filtered (stream, "<error type>");
544 case TYPE_CODE_UNDEF:
545 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
546 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
547 and no complete type for struct foo in that file. */
548 fprintf_filtered (stream, "<incomplete type>");
552 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type));
559 pascal_value_print (struct value *val, struct ui_file *stream,
560 const struct value_print_options *options)
562 struct type *type = value_type (val);
563 struct value_print_options opts = *options;
567 /* If it is a pointer, indicate what it points to.
569 Print type also if it is a reference.
571 Object pascal: if it is a member pointer, we will take care
572 of that when we print it. */
573 if (TYPE_CODE (type) == TYPE_CODE_PTR
574 || TYPE_CODE (type) == TYPE_CODE_REF)
576 /* Hack: remove (char *) for char strings. Their
577 type is indicated by the quoted string anyway. */
578 if (TYPE_CODE (type) == TYPE_CODE_PTR
579 && TYPE_NAME (type) == NULL
580 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
581 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
587 fprintf_filtered (stream, "(");
588 type_print (type, "", stream, -1);
589 fprintf_filtered (stream, ") ");
592 return common_val_print (val, stream, 0, &opts, current_language);
597 show_pascal_static_field_print (struct ui_file *file, int from_tty,
598 struct cmd_list_element *c, const char *value)
600 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
604 static struct obstack dont_print_vb_obstack;
605 static struct obstack dont_print_statmem_obstack;
607 static void pascal_object_print_static_field (struct value *,
608 struct ui_file *, int,
609 const struct value_print_options *);
611 static void pascal_object_print_value (struct type *, const gdb_byte *,
612 CORE_ADDR, struct ui_file *, int,
613 const struct value_print_options *,
616 /* It was changed to this after 2.4.5. */
617 const char pascal_vtbl_ptr_name[] =
618 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
620 /* Return truth value for assertion that TYPE is of the type
621 "pointer to virtual function". */
624 pascal_object_is_vtbl_ptr_type (struct type *type)
626 char *typename = type_name_no_tag (type);
628 return (typename != NULL
629 && strcmp (typename, pascal_vtbl_ptr_name) == 0);
632 /* Return truth value for the assertion that TYPE is of the type
633 "pointer to virtual function table". */
636 pascal_object_is_vtbl_member (struct type *type)
638 if (TYPE_CODE (type) == TYPE_CODE_PTR)
640 type = TYPE_TARGET_TYPE (type);
641 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
643 type = TYPE_TARGET_TYPE (type);
644 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* if not using thunks */
645 || TYPE_CODE (type) == TYPE_CODE_PTR) /* if using thunks */
647 /* Virtual functions tables are full of pointers
648 to virtual functions. */
649 return pascal_object_is_vtbl_ptr_type (type);
656 /* Mutually recursive subroutines of pascal_object_print_value and
657 c_val_print to print out a structure's fields:
658 pascal_object_print_value_fields and pascal_object_print_value.
660 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
661 same meanings as in pascal_object_print_value and c_val_print.
663 DONT_PRINT is an array of baseclass types that we
664 should not print, or zero if called from top level. */
667 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
668 CORE_ADDR address, struct ui_file *stream,
670 const struct value_print_options *options,
671 struct type **dont_print_vb,
672 int dont_print_statmem)
674 int i, len, n_baseclasses;
675 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
677 CHECK_TYPEDEF (type);
679 fprintf_filtered (stream, "{");
680 len = TYPE_NFIELDS (type);
681 n_baseclasses = TYPE_N_BASECLASSES (type);
683 /* Print out baseclasses such that we don't print
684 duplicates of virtual baseclasses. */
685 if (n_baseclasses > 0)
686 pascal_object_print_value (type, valaddr, address, stream,
687 recurse + 1, options, dont_print_vb);
689 if (!len && n_baseclasses == 1)
690 fprintf_filtered (stream, "<No data fields>");
693 struct obstack tmp_obstack = dont_print_statmem_obstack;
696 if (dont_print_statmem == 0)
698 /* If we're at top level, carve out a completely fresh
699 chunk of the obstack and use that until this particular
700 invocation returns. */
701 obstack_finish (&dont_print_statmem_obstack);
704 for (i = n_baseclasses; i < len; i++)
706 /* If requested, skip printing of static fields. */
707 if (!options->pascal_static_field_print
708 && field_is_static (&TYPE_FIELD (type, i)))
711 fprintf_filtered (stream, ", ");
712 else if (n_baseclasses > 0)
716 fprintf_filtered (stream, "\n");
717 print_spaces_filtered (2 + 2 * recurse, stream);
718 fputs_filtered ("members of ", stream);
719 fputs_filtered (type_name_no_tag (type), stream);
720 fputs_filtered (": ", stream);
727 fprintf_filtered (stream, "\n");
728 print_spaces_filtered (2 + 2 * recurse, stream);
732 wrap_here (n_spaces (2 + 2 * recurse));
734 if (options->inspect_it)
736 if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
737 fputs_filtered ("\"( ptr \"", stream);
739 fputs_filtered ("\"( nodef \"", stream);
740 if (field_is_static (&TYPE_FIELD (type, i)))
741 fputs_filtered ("static ", stream);
742 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
744 DMGL_PARAMS | DMGL_ANSI);
745 fputs_filtered ("\" \"", stream);
746 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
748 DMGL_PARAMS | DMGL_ANSI);
749 fputs_filtered ("\") \"", stream);
753 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
755 if (field_is_static (&TYPE_FIELD (type, i)))
756 fputs_filtered ("static ", stream);
757 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
759 DMGL_PARAMS | DMGL_ANSI);
760 annotate_field_name_end ();
761 fputs_filtered (" = ", stream);
762 annotate_field_value ();
765 if (!field_is_static (&TYPE_FIELD (type, i))
766 && TYPE_FIELD_PACKED (type, i))
770 /* Bitfields require special handling, especially due to byte
772 if (TYPE_FIELD_IGNORE (type, i))
774 fputs_filtered ("<optimized out or zero length>", stream);
778 struct value_print_options opts = *options;
780 v = value_from_longest (TYPE_FIELD_TYPE (type, i),
781 unpack_field_as_long (type, valaddr, i));
784 common_val_print (v, stream, recurse + 1, &opts,
790 if (TYPE_FIELD_IGNORE (type, i))
792 fputs_filtered ("<optimized out or zero length>", stream);
794 else if (field_is_static (&TYPE_FIELD (type, i)))
796 /* struct value *v = value_static_field (type, i); v4.17 specific */
799 v = value_from_longest (TYPE_FIELD_TYPE (type, i),
800 unpack_field_as_long (type, valaddr, i));
803 fputs_filtered ("<optimized out>", stream);
805 pascal_object_print_static_field (v, stream, recurse + 1,
810 struct value_print_options opts = *options;
813 /* val_print (TYPE_FIELD_TYPE (type, i),
814 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
815 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
816 stream, format, 0, recurse + 1, pretty); */
817 val_print (TYPE_FIELD_TYPE (type, i),
818 valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
819 address + TYPE_FIELD_BITPOS (type, i) / 8,
820 stream, recurse + 1, &opts,
824 annotate_field_end ();
827 if (dont_print_statmem == 0)
829 /* Free the space used to deal with the printing
830 of the members from top level. */
831 obstack_free (&dont_print_statmem_obstack, last_dont_print);
832 dont_print_statmem_obstack = tmp_obstack;
837 fprintf_filtered (stream, "\n");
838 print_spaces_filtered (2 * recurse, stream);
841 fprintf_filtered (stream, "}");
844 /* Special val_print routine to avoid printing multiple copies of virtual
848 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
849 CORE_ADDR address, struct ui_file *stream,
851 const struct value_print_options *options,
852 struct type **dont_print_vb)
854 struct type **last_dont_print
855 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
856 struct obstack tmp_obstack = dont_print_vb_obstack;
857 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
859 if (dont_print_vb == 0)
861 /* If we're at top level, carve out a completely fresh
862 chunk of the obstack and use that until this particular
863 invocation returns. */
864 /* Bump up the high-water mark. Now alpha is omega. */
865 obstack_finish (&dont_print_vb_obstack);
868 for (i = 0; i < n_baseclasses; i++)
871 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
872 char *basename = type_name_no_tag (baseclass);
873 const gdb_byte *base_valaddr;
875 if (BASETYPE_VIA_VIRTUAL (type, i))
877 struct type **first_dont_print
878 = (struct type **) obstack_base (&dont_print_vb_obstack);
880 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
884 if (baseclass == first_dont_print[j])
887 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
890 boffset = baseclass_offset (type, i, valaddr, address);
894 fprintf_filtered (stream, "\n");
895 print_spaces_filtered (2 * recurse, stream);
897 fputs_filtered ("<", stream);
898 /* Not sure what the best notation is in the case where there is no
901 fputs_filtered (basename ? basename : "", stream);
902 fputs_filtered ("> = ", stream);
904 /* The virtual base class pointer might have been clobbered by the
905 user program. Make sure that it still points to a valid memory
908 if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
910 /* FIXME (alloc): not safe is baseclass is really really big. */
911 gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
914 if (target_read_memory (address + boffset, buf,
915 TYPE_LENGTH (baseclass)) != 0)
919 base_valaddr = valaddr + boffset;
922 fprintf_filtered (stream, "<invalid address>");
924 pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
925 stream, recurse, options,
926 (struct type **) obstack_base (&dont_print_vb_obstack),
928 fputs_filtered (", ", stream);
934 if (dont_print_vb == 0)
936 /* Free the space used to deal with the printing
937 of this type from top level. */
938 obstack_free (&dont_print_vb_obstack, last_dont_print);
939 /* Reset watermark so that we can continue protecting
940 ourselves from whatever we were protecting ourselves. */
941 dont_print_vb_obstack = tmp_obstack;
945 /* Print value of a static member.
946 To avoid infinite recursion when printing a class that contains
947 a static instance of the class, we keep the addresses of all printed
948 static member classes in an obstack and refuse to print them more
951 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
952 have the same meanings as in c_val_print. */
955 pascal_object_print_static_field (struct value *val,
956 struct ui_file *stream,
958 const struct value_print_options *options)
960 struct type *type = value_type (val);
961 struct value_print_options opts;
963 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
965 CORE_ADDR *first_dont_print, addr;
969 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
970 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
975 if (value_address (val) == first_dont_print[i])
977 fputs_filtered ("<same as static member of an already seen type>",
983 addr = value_address (val);
984 obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
987 CHECK_TYPEDEF (type);
988 pascal_object_print_value_fields (type, value_contents (val), addr,
989 stream, recurse, options, NULL, 1);
995 common_val_print (val, stream, recurse, &opts, current_language);
998 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
1001 _initialize_pascal_valprint (void)
1003 add_setshow_boolean_cmd ("pascal_static-members", class_support,
1004 &user_print_options.pascal_static_field_print, _("\
1005 Set printing of pascal static members."), _("\
1006 Show printing of pascal static members."), NULL,
1008 show_pascal_static_field_print,
1009 &setprintlist, &showprintlist);