1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011
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
*original_value
,
58 const struct value_print_options
*options
)
60 struct gdbarch
*gdbarch
= get_type_arch (type
);
61 enum bfd_endian byte_order
= gdbarch_byte_order (gdbarch
);
62 unsigned int i
= 0; /* Number of characters printed */
64 LONGEST low_bound
, high_bound
;
67 int length_pos
, length_size
, string_pos
;
68 struct type
*char_type
;
73 switch (TYPE_CODE (type
))
76 if (get_array_bounds (type
, &low_bound
, &high_bound
))
78 len
= high_bound
- low_bound
+ 1;
79 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
80 eltlen
= TYPE_LENGTH (elttype
);
81 if (options
->prettyprint_arrays
)
83 print_spaces_filtered (2 + 2 * recurse
, stream
);
85 /* If 's' format is used, try to print out as string.
86 If no format is given, print as string if element type
87 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
88 if (options
->format
== 's'
89 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
90 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
91 && options
->format
== 0))
93 /* If requested, look for the first null char and only print
95 if (options
->stop_print_at_null
)
97 unsigned int temp_len
;
99 /* Look for a NULL char. */
101 extract_unsigned_integer (valaddr
+ embedded_offset
+
102 temp_len
* eltlen
, eltlen
,
104 && temp_len
< len
&& temp_len
< options
->print_max
;
109 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
110 valaddr
+ embedded_offset
, len
, NULL
, 0,
116 fprintf_filtered (stream
, "{");
117 /* If this is a virtual function table, print the 0th
118 entry specially, and the rest of the members normally. */
119 if (pascal_object_is_vtbl_ptr_type (elttype
))
122 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
128 val_print_array_elements (type
, valaddr
+ embedded_offset
,
129 address
, stream
, recurse
,
130 original_value
, options
, i
);
131 fprintf_filtered (stream
, "}");
135 /* Array of unspecified length: treat like pointer to first elt. */
137 goto print_unpacked_pointer
;
140 if (options
->format
&& options
->format
!= 's')
142 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
146 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
148 /* Print the unmangled name if desired. */
149 /* Print vtable entry - we only get here if we ARE using
150 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
151 /* Extract the address, assume that it is unsigned. */
152 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
153 TYPE_LENGTH (type
), byte_order
);
154 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
157 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
159 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
160 print_unpacked_pointer
:
161 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
163 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
165 /* Try to print what function it points to. */
166 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
167 /* Return value is irrelevant except for string pointers. */
171 if (options
->addressprint
&& options
->format
!= 's')
173 fputs_filtered (paddress (gdbarch
, addr
), stream
);
176 /* For a pointer to char or unsigned char, also print the string
177 pointed to, unless pointer is null. */
178 if (((TYPE_LENGTH (elttype
) == 1
179 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
180 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
181 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
182 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
183 && (options
->format
== 0 || options
->format
== 's')
186 /* no wide string yet */
187 i
= val_print_string (elttype
, NULL
, addr
, -1, stream
, options
);
189 /* also for pointers to pascal strings */
190 /* Note: this is Free Pascal specific:
191 as GDB does not recognize stabs pascal strings
192 Pascal strings are mapped to records
193 with lowercase names PM */
194 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
195 &string_pos
, &char_type
, NULL
)
198 ULONGEST string_length
;
201 buffer
= xmalloc (length_size
);
202 read_memory (addr
+ length_pos
, buffer
, length_size
);
203 string_length
= extract_unsigned_integer (buffer
, length_size
,
206 i
= val_print_string (char_type
, NULL
,
207 addr
+ string_pos
, string_length
,
210 else if (pascal_object_is_vtbl_member (type
))
212 /* print vtbl's nicely */
213 CORE_ADDR vt_address
= unpack_pointer (type
,
214 valaddr
+ embedded_offset
);
215 struct minimal_symbol
*msymbol
=
216 lookup_minimal_symbol_by_pc (vt_address
);
218 if ((msymbol
!= NULL
)
219 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
221 fputs_filtered (" <", stream
);
222 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
223 fputs_filtered (">", stream
);
225 if (vt_address
&& options
->vtblprint
)
227 struct value
*vt_val
;
228 struct symbol
*wsym
= (struct symbol
*) NULL
;
230 struct block
*block
= (struct block
*) NULL
;
234 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
235 VAR_DOMAIN
, &is_this_fld
);
239 wtype
= SYMBOL_TYPE (wsym
);
243 wtype
= TYPE_TARGET_TYPE (type
);
245 vt_val
= value_at (wtype
, vt_address
);
246 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
250 fprintf_filtered (stream
, "\n");
251 print_spaces_filtered (2 + 2 * recurse
, stream
);
256 /* Return number of characters printed, including the terminating
257 '\0' if we reached the end. val_print_string takes care including
258 the terminating '\0' if necessary. */
264 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
265 if (options
->addressprint
)
268 = extract_typed_address (valaddr
+ embedded_offset
, type
);
270 fprintf_filtered (stream
, "@");
271 fputs_filtered (paddress (gdbarch
, addr
), stream
);
272 if (options
->deref_ref
)
273 fputs_filtered (": ", stream
);
275 /* De-reference the reference. */
276 if (options
->deref_ref
)
278 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
280 struct value
*deref_val
=
282 (TYPE_TARGET_TYPE (type
),
283 unpack_pointer (type
, valaddr
+ embedded_offset
));
285 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
289 fputs_filtered ("???", stream
);
293 case TYPE_CODE_UNION
:
294 if (recurse
&& !options
->unionprint
)
296 fprintf_filtered (stream
, "{...}");
300 case TYPE_CODE_STRUCT
:
301 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
303 /* Print the unmangled name if desired. */
304 /* Print vtable entry - we only get here if NOT using
305 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
306 /* Extract the address, assume that it is unsigned. */
307 print_address_demangle
309 extract_unsigned_integer (valaddr
+ embedded_offset
310 + TYPE_FIELD_BITPOS (type
,
311 VTBL_FNADDR_OFFSET
) / 8,
312 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
313 VTBL_FNADDR_OFFSET
)),
319 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
320 &string_pos
, &char_type
, NULL
))
322 len
= extract_unsigned_integer (valaddr
+ embedded_offset
323 + length_pos
, length_size
,
325 LA_PRINT_STRING (stream
, char_type
,
326 valaddr
+ embedded_offset
+ string_pos
,
327 len
, NULL
, 0, options
);
330 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
,
331 address
, stream
, recurse
,
332 original_value
, options
,
340 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
344 len
= TYPE_NFIELDS (type
);
345 val
= unpack_long (type
, valaddr
+ embedded_offset
);
346 for (i
= 0; i
< len
; i
++)
349 if (val
== TYPE_FIELD_BITPOS (type
, i
))
356 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
360 print_longest (stream
, 'd', 0, val
);
364 case TYPE_CODE_FLAGS
:
366 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
369 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
375 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
379 /* FIXME, we should consider, at least for ANSI C language, eliminating
380 the distinction made between FUNCs and POINTERs to FUNCs. */
381 fprintf_filtered (stream
, "{");
382 type_print (type
, "", stream
, -1);
383 fprintf_filtered (stream
, "} ");
384 /* Try to print what function it points to, and its address. */
385 print_address_demangle (gdbarch
, address
, stream
, demangle
);
389 if (options
->format
|| options
->output_format
)
391 struct value_print_options opts
= *options
;
393 opts
.format
= (options
->format
? options
->format
394 : options
->output_format
);
395 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
400 val
= unpack_long (type
, valaddr
+ embedded_offset
);
402 fputs_filtered ("false", stream
);
404 fputs_filtered ("true", stream
);
407 fputs_filtered ("true (", stream
);
408 fprintf_filtered (stream
, "%ld)", (long int) val
);
413 case TYPE_CODE_RANGE
:
414 /* FIXME: create_range_type does not set the unsigned bit in a
415 range type (I think it probably should copy it from the target
416 type), so we won't print values which are too large to
417 fit in a signed integer correctly. */
418 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
419 print with the target type, though, because the size of our type
420 and the target type might differ). */
424 if (options
->format
|| options
->output_format
)
426 struct value_print_options opts
= *options
;
428 opts
.format
= (options
->format
? options
->format
429 : options
->output_format
);
430 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
435 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
440 if (options
->format
|| options
->output_format
)
442 struct value_print_options opts
= *options
;
444 opts
.format
= (options
->format
? options
->format
445 : options
->output_format
);
446 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
451 val
= unpack_long (type
, valaddr
+ embedded_offset
);
452 if (TYPE_UNSIGNED (type
))
453 fprintf_filtered (stream
, "%u", (unsigned int) val
);
455 fprintf_filtered (stream
, "%d", (int) val
);
456 fputs_filtered (" ", stream
);
457 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
464 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
469 print_floating (valaddr
+ embedded_offset
, type
, stream
);
473 case TYPE_CODE_BITSTRING
:
475 elttype
= TYPE_INDEX_TYPE (type
);
476 CHECK_TYPEDEF (elttype
);
477 if (TYPE_STUB (elttype
))
479 fprintf_filtered (stream
, "<incomplete type>");
485 struct type
*range
= elttype
;
486 LONGEST low_bound
, high_bound
;
488 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
492 fputs_filtered ("B'", stream
);
494 fputs_filtered ("[", stream
);
496 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
497 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
499 /* If we know the size of the set type, we can figure out the
502 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
503 TYPE_HIGH_BOUND (range
) = high_bound
;
508 fputs_filtered ("<error value>", stream
);
512 for (i
= low_bound
; i
<= high_bound
; i
++)
514 int element
= value_bit_index (type
,
515 valaddr
+ embedded_offset
, i
);
520 goto maybe_bad_bstring
;
523 fprintf_filtered (stream
, "%d", element
);
527 fputs_filtered (", ", stream
);
528 print_type_scalar (range
, i
, stream
);
531 if (i
+ 1 <= high_bound
532 && value_bit_index (type
,
533 valaddr
+ embedded_offset
, ++i
))
537 fputs_filtered ("..", stream
);
538 while (i
+ 1 <= high_bound
539 && value_bit_index (type
,
540 valaddr
+ embedded_offset
,
543 print_type_scalar (range
, j
, stream
);
549 fputs_filtered ("'", stream
);
551 fputs_filtered ("]", stream
);
556 fprintf_filtered (stream
, "void");
559 case TYPE_CODE_ERROR
:
560 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
563 case TYPE_CODE_UNDEF
:
564 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
565 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
566 and no complete type for struct foo in that file. */
567 fprintf_filtered (stream
, "<incomplete type>");
571 error (_("Invalid pascal type code %d in symbol table."),
579 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
580 const struct value_print_options
*options
)
582 struct type
*type
= value_type (val
);
583 struct value_print_options opts
= *options
;
587 /* If it is a pointer, indicate what it points to.
589 Print type also if it is a reference.
591 Object pascal: if it is a member pointer, we will take care
592 of that when we print it. */
593 if (TYPE_CODE (type
) == TYPE_CODE_PTR
594 || TYPE_CODE (type
) == TYPE_CODE_REF
)
596 /* Hack: remove (char *) for char strings. Their
597 type is indicated by the quoted string anyway. */
598 if (TYPE_CODE (type
) == TYPE_CODE_PTR
599 && TYPE_NAME (type
) == NULL
600 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
601 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
607 fprintf_filtered (stream
, "(");
608 type_print (type
, "", stream
, -1);
609 fprintf_filtered (stream
, ") ");
612 return common_val_print (val
, stream
, 0, &opts
, current_language
);
617 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
618 struct cmd_list_element
*c
, const char *value
)
620 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
624 static struct obstack dont_print_vb_obstack
;
625 static struct obstack dont_print_statmem_obstack
;
627 static void pascal_object_print_static_field (struct value
*,
628 struct ui_file
*, int,
629 const struct value_print_options
*);
631 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
632 CORE_ADDR
, struct ui_file
*, int,
633 const struct value
*,
634 const struct value_print_options
*,
637 /* It was changed to this after 2.4.5. */
638 const char pascal_vtbl_ptr_name
[] =
639 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
641 /* Return truth value for assertion that TYPE is of the type
642 "pointer to virtual function". */
645 pascal_object_is_vtbl_ptr_type (struct type
*type
)
647 char *typename
= type_name_no_tag (type
);
649 return (typename
!= NULL
650 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
653 /* Return truth value for the assertion that TYPE is of the type
654 "pointer to virtual function table". */
657 pascal_object_is_vtbl_member (struct type
*type
)
659 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
661 type
= TYPE_TARGET_TYPE (type
);
662 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
664 type
= TYPE_TARGET_TYPE (type
);
665 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using
667 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
669 /* Virtual functions tables are full of pointers
670 to virtual functions. */
671 return pascal_object_is_vtbl_ptr_type (type
);
678 /* Mutually recursive subroutines of pascal_object_print_value and
679 c_val_print to print out a structure's fields:
680 pascal_object_print_value_fields and pascal_object_print_value.
682 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
683 same meanings as in pascal_object_print_value and c_val_print.
685 DONT_PRINT is an array of baseclass types that we
686 should not print, or zero if called from top level. */
689 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
690 CORE_ADDR address
, struct ui_file
*stream
,
692 const struct value
*val
,
693 const struct value_print_options
*options
,
694 struct type
**dont_print_vb
,
695 int dont_print_statmem
)
697 int i
, len
, n_baseclasses
;
698 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
700 CHECK_TYPEDEF (type
);
702 fprintf_filtered (stream
, "{");
703 len
= TYPE_NFIELDS (type
);
704 n_baseclasses
= TYPE_N_BASECLASSES (type
);
706 /* Print out baseclasses such that we don't print
707 duplicates of virtual baseclasses. */
708 if (n_baseclasses
> 0)
709 pascal_object_print_value (type
, valaddr
, address
, stream
,
710 recurse
+ 1, val
, options
, dont_print_vb
);
712 if (!len
&& n_baseclasses
== 1)
713 fprintf_filtered (stream
, "<No data fields>");
716 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
719 if (dont_print_statmem
== 0)
721 /* If we're at top level, carve out a completely fresh
722 chunk of the obstack and use that until this particular
723 invocation returns. */
724 obstack_finish (&dont_print_statmem_obstack
);
727 for (i
= n_baseclasses
; i
< len
; i
++)
729 /* If requested, skip printing of static fields. */
730 if (!options
->pascal_static_field_print
731 && field_is_static (&TYPE_FIELD (type
, i
)))
734 fprintf_filtered (stream
, ", ");
735 else if (n_baseclasses
> 0)
739 fprintf_filtered (stream
, "\n");
740 print_spaces_filtered (2 + 2 * recurse
, stream
);
741 fputs_filtered ("members of ", stream
);
742 fputs_filtered (type_name_no_tag (type
), stream
);
743 fputs_filtered (": ", stream
);
750 fprintf_filtered (stream
, "\n");
751 print_spaces_filtered (2 + 2 * recurse
, stream
);
755 wrap_here (n_spaces (2 + 2 * recurse
));
757 if (options
->inspect_it
)
759 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
760 fputs_filtered ("\"( ptr \"", stream
);
762 fputs_filtered ("\"( nodef \"", stream
);
763 if (field_is_static (&TYPE_FIELD (type
, i
)))
764 fputs_filtered ("static ", stream
);
765 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
767 DMGL_PARAMS
| DMGL_ANSI
);
768 fputs_filtered ("\" \"", stream
);
769 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
771 DMGL_PARAMS
| DMGL_ANSI
);
772 fputs_filtered ("\") \"", stream
);
776 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
778 if (field_is_static (&TYPE_FIELD (type
, i
)))
779 fputs_filtered ("static ", stream
);
780 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
782 DMGL_PARAMS
| DMGL_ANSI
);
783 annotate_field_name_end ();
784 fputs_filtered (" = ", stream
);
785 annotate_field_value ();
788 if (!field_is_static (&TYPE_FIELD (type
, i
))
789 && TYPE_FIELD_PACKED (type
, i
))
793 /* Bitfields require special handling, especially due to byte
795 if (TYPE_FIELD_IGNORE (type
, i
))
797 fputs_filtered ("<optimized out or zero length>", stream
);
799 else if (value_bits_synthetic_pointer (val
,
800 TYPE_FIELD_BITPOS (type
,
802 TYPE_FIELD_BITSIZE (type
,
805 fputs_filtered (_("<synthetic pointer>"), stream
);
807 else if (!value_bits_valid (val
, TYPE_FIELD_BITPOS (type
, i
),
808 TYPE_FIELD_BITSIZE (type
, i
)))
810 fputs_filtered (_("<value optimized out>"), stream
);
814 struct value_print_options opts
= *options
;
816 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
817 unpack_field_as_long (type
, valaddr
, i
));
820 common_val_print (v
, stream
, recurse
+ 1, &opts
,
826 if (TYPE_FIELD_IGNORE (type
, i
))
828 fputs_filtered ("<optimized out or zero length>", stream
);
830 else if (field_is_static (&TYPE_FIELD (type
, i
)))
832 /* struct value *v = value_static_field (type, i);
836 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
837 unpack_field_as_long (type
, valaddr
, i
));
840 fputs_filtered ("<optimized out>", stream
);
842 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
847 struct value_print_options opts
= *options
;
850 /* val_print (TYPE_FIELD_TYPE (type, i),
851 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
852 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
853 stream, format, 0, recurse + 1, pretty); */
854 val_print (TYPE_FIELD_TYPE (type
, i
),
855 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
856 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
857 stream
, recurse
+ 1, val
, &opts
,
861 annotate_field_end ();
864 if (dont_print_statmem
== 0)
866 /* Free the space used to deal with the printing
867 of the members from top level. */
868 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
869 dont_print_statmem_obstack
= tmp_obstack
;
874 fprintf_filtered (stream
, "\n");
875 print_spaces_filtered (2 * recurse
, stream
);
878 fprintf_filtered (stream
, "}");
881 /* Special val_print routine to avoid printing multiple copies of virtual
885 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
886 CORE_ADDR address
, struct ui_file
*stream
,
888 const struct value
*val
,
889 const struct value_print_options
*options
,
890 struct type
**dont_print_vb
)
892 struct type
**last_dont_print
893 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
894 struct obstack tmp_obstack
= dont_print_vb_obstack
;
895 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
897 if (dont_print_vb
== 0)
899 /* If we're at top level, carve out a completely fresh
900 chunk of the obstack and use that until this particular
901 invocation returns. */
902 /* Bump up the high-water mark. Now alpha is omega. */
903 obstack_finish (&dont_print_vb_obstack
);
906 for (i
= 0; i
< n_baseclasses
; i
++)
909 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
910 char *basename
= type_name_no_tag (baseclass
);
911 const gdb_byte
*base_valaddr
;
913 if (BASETYPE_VIA_VIRTUAL (type
, i
))
915 struct type
**first_dont_print
916 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
918 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
922 if (baseclass
== first_dont_print
[j
])
925 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
928 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
932 fprintf_filtered (stream
, "\n");
933 print_spaces_filtered (2 * recurse
, stream
);
935 fputs_filtered ("<", stream
);
936 /* Not sure what the best notation is in the case where there is no
939 fputs_filtered (basename
? basename
: "", stream
);
940 fputs_filtered ("> = ", stream
);
942 /* The virtual base class pointer might have been clobbered by the
943 user program. Make sure that it still points to a valid memory
946 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
948 /* FIXME (alloc): not safe is baseclass is really really big. */
949 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
952 if (target_read_memory (address
+ boffset
, buf
,
953 TYPE_LENGTH (baseclass
)) != 0)
957 base_valaddr
= valaddr
+ boffset
;
960 fprintf_filtered (stream
, "<invalid address>");
962 pascal_object_print_value_fields (baseclass
, base_valaddr
,
963 address
+ boffset
, stream
,
964 recurse
, val
, options
,
965 (struct type
**) obstack_base (&dont_print_vb_obstack
),
967 fputs_filtered (", ", stream
);
973 if (dont_print_vb
== 0)
975 /* Free the space used to deal with the printing
976 of this type from top level. */
977 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
978 /* Reset watermark so that we can continue protecting
979 ourselves from whatever we were protecting ourselves. */
980 dont_print_vb_obstack
= tmp_obstack
;
984 /* Print value of a static member.
985 To avoid infinite recursion when printing a class that contains
986 a static instance of the class, we keep the addresses of all printed
987 static member classes in an obstack and refuse to print them more
990 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
991 have the same meanings as in c_val_print. */
994 pascal_object_print_static_field (struct value
*val
,
995 struct ui_file
*stream
,
997 const struct value_print_options
*options
)
999 struct type
*type
= value_type (val
);
1000 struct value_print_options opts
;
1002 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1004 CORE_ADDR
*first_dont_print
, addr
;
1008 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1009 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1014 if (value_address (val
) == first_dont_print
[i
])
1017 <same as static member of an already seen type>",
1023 addr
= value_address (val
);
1024 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
1025 sizeof (CORE_ADDR
));
1027 CHECK_TYPEDEF (type
);
1028 pascal_object_print_value_fields (type
, value_contents (val
), addr
,
1029 stream
, recurse
, NULL
, options
,
1036 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
1039 /* -Wmissing-prototypes */
1040 extern initialize_file_ftype _initialize_pascal_valprint
;
1043 _initialize_pascal_valprint (void)
1045 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
1046 &user_print_options
.pascal_static_field_print
, _("\
1047 Set printing of pascal static members."), _("\
1048 Show printing of pascal static members."), NULL
,
1050 show_pascal_static_field_print
,
1051 &setprintlist
, &showprintlist
);