1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007
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 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
50 If the data are a string pointer, returns the number of string characters
53 If DEREF_REF is nonzero, then dereference references, otherwise just print
56 The PRETTY parameter controls prettyprinting. */
60 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
61 int embedded_offset
, CORE_ADDR address
,
62 struct ui_file
*stream
, int format
, int deref_ref
,
63 int recurse
, enum val_prettyprint pretty
)
65 unsigned int i
= 0; /* Number of characters printed */
69 int length_pos
, length_size
, string_pos
;
75 switch (TYPE_CODE (type
))
78 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
80 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
81 eltlen
= TYPE_LENGTH (elttype
);
82 len
= TYPE_LENGTH (type
) / eltlen
;
83 if (prettyprint_arrays
)
85 print_spaces_filtered (2 + 2 * recurse
, stream
);
87 /* For an array of chars, print with string syntax. */
89 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
90 || ((current_language
->la_language
== language_m2
)
91 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
92 && (format
== 0 || format
== 's'))
94 /* If requested, look for the first null char and only print
96 if (stop_print_at_null
)
98 unsigned int temp_len
;
100 /* Look for a NULL char. */
102 (valaddr
+ embedded_offset
)[temp_len
]
103 && temp_len
< len
&& temp_len
< print_max
;
108 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
113 fprintf_filtered (stream
, "{");
114 /* If this is a virtual function table, print the 0th
115 entry specially, and the rest of the members normally. */
116 if (pascal_object_is_vtbl_ptr_type (elttype
))
119 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
125 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
126 format
, deref_ref
, recurse
, pretty
, i
);
127 fprintf_filtered (stream
, "}");
131 /* Array of unspecified length: treat like pointer to first elt. */
133 goto print_unpacked_pointer
;
136 if (format
&& format
!= 's')
138 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
141 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
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 print_address_demangle (extract_unsigned_integer (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
151 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
153 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
154 print_unpacked_pointer
:
155 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
157 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
159 /* Try to print what function it points to. */
160 print_address_demangle (addr
, stream
, demangle
);
161 /* Return value is irrelevant except for string pointers. */
165 if (addressprint
&& format
!= 's')
167 deprecated_print_address_numeric (addr
, 1, stream
);
170 /* For a pointer to char or unsigned char, also print the string
171 pointed to, unless pointer is null. */
172 if (TYPE_LENGTH (elttype
) == 1
173 && TYPE_CODE (elttype
) == TYPE_CODE_INT
174 && (format
== 0 || format
== 's')
177 /* no wide string yet */
178 i
= val_print_string (addr
, -1, 1, stream
);
180 /* also for pointers to pascal strings */
181 /* Note: this is Free Pascal specific:
182 as GDB does not recognize stabs pascal strings
183 Pascal strings are mapped to records
184 with lowercase names PM */
185 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
186 &string_pos
, &char_size
, NULL
)
189 ULONGEST string_length
;
191 buffer
= xmalloc (length_size
);
192 read_memory (addr
+ length_pos
, buffer
, length_size
);
193 string_length
= extract_unsigned_integer (buffer
, length_size
);
195 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
197 else if (pascal_object_is_vtbl_member (type
))
199 /* print vtbl's nicely */
200 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
202 struct minimal_symbol
*msymbol
=
203 lookup_minimal_symbol_by_pc (vt_address
);
204 if ((msymbol
!= NULL
)
205 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
207 fputs_filtered (" <", stream
);
208 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
209 fputs_filtered (">", stream
);
211 if (vt_address
&& vtblprint
)
213 struct value
*vt_val
;
214 struct symbol
*wsym
= (struct symbol
*) NULL
;
216 struct block
*block
= (struct block
*) NULL
;
220 wsym
= lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol
), block
,
221 VAR_DOMAIN
, &is_this_fld
, NULL
);
225 wtype
= SYMBOL_TYPE (wsym
);
229 wtype
= TYPE_TARGET_TYPE (type
);
231 vt_val
= value_at (wtype
, vt_address
);
232 common_val_print (vt_val
, stream
, format
, deref_ref
,
233 recurse
+ 1, pretty
);
236 fprintf_filtered (stream
, "\n");
237 print_spaces_filtered (2 + 2 * recurse
, stream
);
242 /* Return number of characters printed, including the terminating
243 '\0' if we reached the end. val_print_string takes care including
244 the terminating '\0' if necessary. */
250 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
253 fprintf_filtered (stream
, "@");
254 /* Extract the address, assume that it is unsigned. */
255 deprecated_print_address_numeric
256 (extract_unsigned_integer (valaddr
+ embedded_offset
,
257 gdbarch_ptr_bit (current_gdbarch
)
261 fputs_filtered (": ", stream
);
263 /* De-reference the reference. */
266 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
268 struct value
*deref_val
=
270 (TYPE_TARGET_TYPE (type
),
271 unpack_pointer (lookup_pointer_type (builtin_type_void
),
272 valaddr
+ embedded_offset
));
273 common_val_print (deref_val
, stream
, format
, deref_ref
,
274 recurse
+ 1, pretty
);
277 fputs_filtered ("???", stream
);
281 case TYPE_CODE_UNION
:
282 if (recurse
&& !unionprint
)
284 fprintf_filtered (stream
, "{...}");
288 case TYPE_CODE_STRUCT
:
289 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
291 /* Print the unmangled name if desired. */
292 /* Print vtable entry - we only get here if NOT using
293 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
294 /* Extract the address, assume that it is unsigned. */
295 print_address_demangle
296 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
297 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
302 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
303 &string_pos
, &char_size
, NULL
))
305 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
306 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
309 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
310 recurse
, pretty
, NULL
, 0);
317 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
320 len
= TYPE_NFIELDS (type
);
321 val
= unpack_long (type
, valaddr
+ embedded_offset
);
322 for (i
= 0; i
< len
; i
++)
325 if (val
== TYPE_FIELD_BITPOS (type
, i
))
332 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
336 print_longest (stream
, 'd', 0, val
);
340 case TYPE_CODE_FLAGS
:
342 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
344 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
350 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
353 /* FIXME, we should consider, at least for ANSI C language, eliminating
354 the distinction made between FUNCs and POINTERs to FUNCs. */
355 fprintf_filtered (stream
, "{");
356 type_print (type
, "", stream
, -1);
357 fprintf_filtered (stream
, "} ");
358 /* Try to print what function it points to, and its address. */
359 print_address_demangle (address
, stream
, demangle
);
363 format
= format
? format
: output_format
;
365 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
368 val
= unpack_long (type
, valaddr
+ embedded_offset
);
370 fputs_filtered ("false", stream
);
372 fputs_filtered ("true", stream
);
375 fputs_filtered ("true (", stream
);
376 fprintf_filtered (stream
, "%ld)", (long int) val
);
381 case TYPE_CODE_RANGE
:
382 /* FIXME: create_range_type does not set the unsigned bit in a
383 range type (I think it probably should copy it from the target
384 type), so we won't print values which are too large to
385 fit in a signed integer correctly. */
386 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
387 print with the target type, though, because the size of our type
388 and the target type might differ). */
392 format
= format
? format
: output_format
;
395 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
399 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
404 format
= format
? format
: output_format
;
407 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
411 val
= unpack_long (type
, valaddr
+ embedded_offset
);
412 if (TYPE_UNSIGNED (type
))
413 fprintf_filtered (stream
, "%u", (unsigned int) val
);
415 fprintf_filtered (stream
, "%d", (int) val
);
416 fputs_filtered (" ", stream
);
417 LA_PRINT_CHAR ((unsigned char) val
, stream
);
424 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
428 print_floating (valaddr
+ embedded_offset
, type
, stream
);
432 case TYPE_CODE_BITSTRING
:
434 elttype
= TYPE_INDEX_TYPE (type
);
435 CHECK_TYPEDEF (elttype
);
436 if (TYPE_STUB (elttype
))
438 fprintf_filtered (stream
, "<incomplete type>");
444 struct type
*range
= elttype
;
445 LONGEST low_bound
, high_bound
;
447 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
451 fputs_filtered ("B'", stream
);
453 fputs_filtered ("[", stream
);
455 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
459 fputs_filtered ("<error value>", stream
);
463 for (i
= low_bound
; i
<= high_bound
; i
++)
465 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
469 goto maybe_bad_bstring
;
472 fprintf_filtered (stream
, "%d", element
);
476 fputs_filtered (", ", stream
);
477 print_type_scalar (range
, i
, stream
);
480 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
483 fputs_filtered ("..", stream
);
484 while (i
+ 1 <= high_bound
485 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
487 print_type_scalar (range
, j
, stream
);
493 fputs_filtered ("'", stream
);
495 fputs_filtered ("]", stream
);
500 fprintf_filtered (stream
, "void");
503 case TYPE_CODE_ERROR
:
504 fprintf_filtered (stream
, "<error type>");
507 case TYPE_CODE_UNDEF
:
508 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
509 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
510 and no complete type for struct foo in that file. */
511 fprintf_filtered (stream
, "<incomplete type>");
515 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
522 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
523 enum val_prettyprint pretty
)
525 struct type
*type
= value_type (val
);
527 /* If it is a pointer, indicate what it points to.
529 Print type also if it is a reference.
531 Object pascal: if it is a member pointer, we will take care
532 of that when we print it. */
533 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
534 TYPE_CODE (type
) == TYPE_CODE_REF
)
536 /* Hack: remove (char *) for char strings. Their
537 type is indicated by the quoted string anyway. */
538 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
539 TYPE_NAME (type
) == NULL
&&
540 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
541 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
547 fprintf_filtered (stream
, "(");
548 type_print (type
, "", stream
, -1);
549 fprintf_filtered (stream
, ") ");
552 return common_val_print (val
, stream
, format
, 1, 0, pretty
);
556 /******************************************************************************
557 Inserted from cp-valprint
558 ******************************************************************************/
560 extern int vtblprint
; /* Controls printing of vtbl's */
561 extern int objectprint
; /* Controls looking up an object's derived type
562 using what we find in its vtables. */
563 static int pascal_static_field_print
; /* Controls printing of static fields. */
565 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
566 struct cmd_list_element
*c
, const char *value
)
568 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
572 static struct obstack dont_print_vb_obstack
;
573 static struct obstack dont_print_statmem_obstack
;
575 static void pascal_object_print_static_field (struct value
*,
576 struct ui_file
*, int, int,
577 enum val_prettyprint
);
579 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
580 CORE_ADDR
, struct ui_file
*,
581 int, int, enum val_prettyprint
,
584 /* It was changed to this after 2.4.5. */
585 const char pascal_vtbl_ptr_name
[] =
586 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
588 /* Return truth value for assertion that TYPE is of the type
589 "pointer to virtual function". */
592 pascal_object_is_vtbl_ptr_type (struct type
*type
)
594 char *typename
= type_name_no_tag (type
);
596 return (typename
!= NULL
597 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
600 /* Return truth value for the assertion that TYPE is of the type
601 "pointer to virtual function table". */
604 pascal_object_is_vtbl_member (struct type
*type
)
606 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
608 type
= TYPE_TARGET_TYPE (type
);
609 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
611 type
= TYPE_TARGET_TYPE (type
);
612 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
613 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
615 /* Virtual functions tables are full of pointers
616 to virtual functions. */
617 return pascal_object_is_vtbl_ptr_type (type
);
624 /* Mutually recursive subroutines of pascal_object_print_value and
625 c_val_print to print out a structure's fields:
626 pascal_object_print_value_fields and pascal_object_print_value.
628 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
629 same meanings as in pascal_object_print_value and c_val_print.
631 DONT_PRINT is an array of baseclass types that we
632 should not print, or zero if called from top level. */
635 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
636 CORE_ADDR address
, struct ui_file
*stream
,
637 int format
, int recurse
,
638 enum val_prettyprint pretty
,
639 struct type
**dont_print_vb
,
640 int dont_print_statmem
)
642 int i
, len
, n_baseclasses
;
643 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
645 CHECK_TYPEDEF (type
);
647 fprintf_filtered (stream
, "{");
648 len
= TYPE_NFIELDS (type
);
649 n_baseclasses
= TYPE_N_BASECLASSES (type
);
651 /* Print out baseclasses such that we don't print
652 duplicates of virtual baseclasses. */
653 if (n_baseclasses
> 0)
654 pascal_object_print_value (type
, valaddr
, address
, stream
,
655 format
, recurse
+ 1, pretty
, dont_print_vb
);
657 if (!len
&& n_baseclasses
== 1)
658 fprintf_filtered (stream
, "<No data fields>");
661 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
664 if (dont_print_statmem
== 0)
666 /* If we're at top level, carve out a completely fresh
667 chunk of the obstack and use that until this particular
668 invocation returns. */
669 obstack_finish (&dont_print_statmem_obstack
);
672 for (i
= n_baseclasses
; i
< len
; i
++)
674 /* If requested, skip printing of static fields. */
675 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
678 fprintf_filtered (stream
, ", ");
679 else if (n_baseclasses
> 0)
683 fprintf_filtered (stream
, "\n");
684 print_spaces_filtered (2 + 2 * recurse
, stream
);
685 fputs_filtered ("members of ", stream
);
686 fputs_filtered (type_name_no_tag (type
), stream
);
687 fputs_filtered (": ", stream
);
694 fprintf_filtered (stream
, "\n");
695 print_spaces_filtered (2 + 2 * recurse
, stream
);
699 wrap_here (n_spaces (2 + 2 * recurse
));
703 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
704 fputs_filtered ("\"( ptr \"", stream
);
706 fputs_filtered ("\"( nodef \"", stream
);
707 if (TYPE_FIELD_STATIC (type
, i
))
708 fputs_filtered ("static ", stream
);
709 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
711 DMGL_PARAMS
| DMGL_ANSI
);
712 fputs_filtered ("\" \"", stream
);
713 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
715 DMGL_PARAMS
| DMGL_ANSI
);
716 fputs_filtered ("\") \"", stream
);
720 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
722 if (TYPE_FIELD_STATIC (type
, i
))
723 fputs_filtered ("static ", stream
);
724 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
726 DMGL_PARAMS
| DMGL_ANSI
);
727 annotate_field_name_end ();
728 fputs_filtered (" = ", stream
);
729 annotate_field_value ();
732 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
736 /* Bitfields require special handling, especially due to byte
738 if (TYPE_FIELD_IGNORE (type
, i
))
740 fputs_filtered ("<optimized out or zero length>", stream
);
744 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
745 unpack_field_as_long (type
, valaddr
, i
));
747 common_val_print (v
, stream
, format
, 0, recurse
+ 1, pretty
);
752 if (TYPE_FIELD_IGNORE (type
, i
))
754 fputs_filtered ("<optimized out or zero length>", stream
);
756 else if (TYPE_FIELD_STATIC (type
, i
))
758 /* struct value *v = value_static_field (type, i); v4.17 specific */
760 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
761 unpack_field_as_long (type
, valaddr
, i
));
764 fputs_filtered ("<optimized out>", stream
);
766 pascal_object_print_static_field (v
, stream
, format
,
767 recurse
+ 1, pretty
);
771 /* val_print (TYPE_FIELD_TYPE (type, i),
772 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
773 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
774 stream, format, 0, recurse + 1, pretty); */
775 val_print (TYPE_FIELD_TYPE (type
, i
),
776 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
777 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
778 stream
, format
, 0, recurse
+ 1, pretty
);
781 annotate_field_end ();
784 if (dont_print_statmem
== 0)
786 /* Free the space used to deal with the printing
787 of the members from top level. */
788 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
789 dont_print_statmem_obstack
= tmp_obstack
;
794 fprintf_filtered (stream
, "\n");
795 print_spaces_filtered (2 * recurse
, stream
);
798 fprintf_filtered (stream
, "}");
801 /* Special val_print routine to avoid printing multiple copies of virtual
805 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
806 CORE_ADDR address
, struct ui_file
*stream
,
807 int format
, int recurse
,
808 enum val_prettyprint pretty
,
809 struct type
**dont_print_vb
)
811 struct type
**last_dont_print
812 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
813 struct obstack tmp_obstack
= dont_print_vb_obstack
;
814 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
816 if (dont_print_vb
== 0)
818 /* If we're at top level, carve out a completely fresh
819 chunk of the obstack and use that until this particular
820 invocation returns. */
821 /* Bump up the high-water mark. Now alpha is omega. */
822 obstack_finish (&dont_print_vb_obstack
);
825 for (i
= 0; i
< n_baseclasses
; i
++)
828 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
829 char *basename
= type_name_no_tag (baseclass
);
830 const gdb_byte
*base_valaddr
;
832 if (BASETYPE_VIA_VIRTUAL (type
, i
))
834 struct type
**first_dont_print
835 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
837 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
841 if (baseclass
== first_dont_print
[j
])
844 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
847 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
851 fprintf_filtered (stream
, "\n");
852 print_spaces_filtered (2 * recurse
, stream
);
854 fputs_filtered ("<", stream
);
855 /* Not sure what the best notation is in the case where there is no
858 fputs_filtered (basename
? basename
: "", stream
);
859 fputs_filtered ("> = ", stream
);
861 /* The virtual base class pointer might have been clobbered by the
862 user program. Make sure that it still points to a valid memory
865 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
867 /* FIXME (alloc): not safe is baseclass is really really big. */
868 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
870 if (target_read_memory (address
+ boffset
, buf
,
871 TYPE_LENGTH (baseclass
)) != 0)
875 base_valaddr
= valaddr
+ boffset
;
878 fprintf_filtered (stream
, "<invalid address>");
880 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
881 stream
, format
, recurse
, pretty
,
882 (struct type
**) obstack_base (&dont_print_vb_obstack
),
884 fputs_filtered (", ", stream
);
890 if (dont_print_vb
== 0)
892 /* Free the space used to deal with the printing
893 of this type from top level. */
894 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
895 /* Reset watermark so that we can continue protecting
896 ourselves from whatever we were protecting ourselves. */
897 dont_print_vb_obstack
= tmp_obstack
;
901 /* Print value of a static member.
902 To avoid infinite recursion when printing a class that contains
903 a static instance of the class, we keep the addresses of all printed
904 static member classes in an obstack and refuse to print them more
907 VAL contains the value to print, STREAM, RECURSE, and PRETTY
908 have the same meanings as in c_val_print. */
911 pascal_object_print_static_field (struct value
*val
,
912 struct ui_file
*stream
, int format
,
913 int recurse
, enum val_prettyprint pretty
)
915 struct type
*type
= value_type (val
);
917 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
919 CORE_ADDR
*first_dont_print
;
923 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
924 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
929 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
931 fputs_filtered ("<same as static member of an already seen type>",
937 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
940 CHECK_TYPEDEF (type
);
941 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
942 stream
, format
, recurse
, pretty
, NULL
, 1);
945 common_val_print (val
, stream
, format
, 0, recurse
, pretty
);
948 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
951 _initialize_pascal_valprint (void)
953 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
954 &pascal_static_field_print
, _("\
955 Set printing of pascal static members."), _("\
956 Show printing of pascal static members."), NULL
,
958 show_pascal_static_field_print
,
959 &setprintlist
, &showprintlist
);
960 /* Turn on printing of static fields. */
961 pascal_static_field_print
= 1;