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 2 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, write to the Free Software
20 Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 /* This file is derived from c-valprint.c */
26 #include "gdb_obstack.h"
29 #include "expression.h"
36 #include "typeprint.h"
42 #include "cp-support.h"
47 /* Print data of type TYPE located at VALADDR (within GDB), which came from
48 the inferior at address ADDRESS, onto stdio stream STREAM according to
49 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
52 If the data are a string pointer, returns the number of string characters
55 If DEREF_REF is nonzero, then dereference references, otherwise just print
58 The PRETTY parameter controls prettyprinting. */
62 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
63 int embedded_offset
, CORE_ADDR address
,
64 struct ui_file
*stream
, int format
, int deref_ref
,
65 int recurse
, enum val_prettyprint pretty
)
67 unsigned int i
= 0; /* Number of characters printed */
71 int length_pos
, length_size
, string_pos
;
77 switch (TYPE_CODE (type
))
80 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
82 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
83 eltlen
= TYPE_LENGTH (elttype
);
84 len
= TYPE_LENGTH (type
) / eltlen
;
85 if (prettyprint_arrays
)
87 print_spaces_filtered (2 + 2 * recurse
, stream
);
89 /* For an array of chars, print with string syntax. */
91 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
92 || ((current_language
->la_language
== language_m2
)
93 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
94 && (format
== 0 || format
== 's'))
96 /* If requested, look for the first null char and only print
98 if (stop_print_at_null
)
100 unsigned int temp_len
;
102 /* Look for a NULL char. */
104 (valaddr
+ embedded_offset
)[temp_len
]
105 && temp_len
< len
&& temp_len
< print_max
;
110 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
115 fprintf_filtered (stream
, "{");
116 /* If this is a virtual function table, print the 0th
117 entry specially, and the rest of the members normally. */
118 if (pascal_object_is_vtbl_ptr_type (elttype
))
121 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
127 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
128 format
, deref_ref
, recurse
, pretty
, i
);
129 fprintf_filtered (stream
, "}");
133 /* Array of unspecified length: treat like pointer to first elt. */
135 goto print_unpacked_pointer
;
138 if (format
&& format
!= 's')
140 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
143 if (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 print_address_demangle (extract_unsigned_integer (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
153 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
155 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
156 print_unpacked_pointer
:
157 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
159 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
161 /* Try to print what function it points to. */
162 print_address_demangle (addr
, stream
, demangle
);
163 /* Return value is irrelevant except for string pointers. */
167 if (addressprint
&& format
!= 's')
169 deprecated_print_address_numeric (addr
, 1, stream
);
172 /* For a pointer to char or unsigned char, also print the string
173 pointed to, unless pointer is null. */
174 if (TYPE_LENGTH (elttype
) == 1
175 && TYPE_CODE (elttype
) == TYPE_CODE_INT
176 && (format
== 0 || format
== 's')
179 /* no wide string yet */
180 i
= val_print_string (addr
, -1, 1, stream
);
182 /* also for pointers to pascal strings */
183 /* Note: this is Free Pascal specific:
184 as GDB does not recognize stabs pascal strings
185 Pascal strings are mapped to records
186 with lowercase names PM */
187 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
188 &string_pos
, &char_size
, NULL
)
191 ULONGEST string_length
;
193 buffer
= xmalloc (length_size
);
194 read_memory (addr
+ length_pos
, buffer
, length_size
);
195 string_length
= extract_unsigned_integer (buffer
, length_size
);
197 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
199 else if (pascal_object_is_vtbl_member (type
))
201 /* print vtbl's nicely */
202 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
204 struct minimal_symbol
*msymbol
=
205 lookup_minimal_symbol_by_pc (vt_address
);
206 if ((msymbol
!= NULL
)
207 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
209 fputs_filtered (" <", stream
);
210 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
211 fputs_filtered (">", stream
);
213 if (vt_address
&& vtblprint
)
215 struct value
*vt_val
;
216 struct symbol
*wsym
= (struct symbol
*) NULL
;
218 struct block
*block
= (struct block
*) NULL
;
222 wsym
= lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol
), block
,
223 VAR_DOMAIN
, &is_this_fld
, NULL
);
227 wtype
= SYMBOL_TYPE (wsym
);
231 wtype
= TYPE_TARGET_TYPE (type
);
233 vt_val
= value_at (wtype
, vt_address
);
234 common_val_print (vt_val
, stream
, format
, deref_ref
,
235 recurse
+ 1, pretty
);
238 fprintf_filtered (stream
, "\n");
239 print_spaces_filtered (2 + 2 * recurse
, stream
);
244 /* Return number of characters printed, including the terminating
245 '\0' if we reached the end. val_print_string takes care including
246 the terminating '\0' if necessary. */
252 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
255 fprintf_filtered (stream
, "@");
256 /* Extract the address, assume that it is unsigned. */
257 deprecated_print_address_numeric
258 (extract_unsigned_integer (valaddr
+ embedded_offset
,
259 gdbarch_ptr_bit (current_gdbarch
)
263 fputs_filtered (": ", stream
);
265 /* De-reference the reference. */
268 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
270 struct value
*deref_val
=
272 (TYPE_TARGET_TYPE (type
),
273 unpack_pointer (lookup_pointer_type (builtin_type_void
),
274 valaddr
+ embedded_offset
));
275 common_val_print (deref_val
, stream
, format
, deref_ref
,
276 recurse
+ 1, pretty
);
279 fputs_filtered ("???", stream
);
283 case TYPE_CODE_UNION
:
284 if (recurse
&& !unionprint
)
286 fprintf_filtered (stream
, "{...}");
290 case TYPE_CODE_STRUCT
:
291 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
293 /* Print the unmangled name if desired. */
294 /* Print vtable entry - we only get here if NOT using
295 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
296 /* Extract the address, assume that it is unsigned. */
297 print_address_demangle
298 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
299 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
304 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
305 &string_pos
, &char_size
, NULL
))
307 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
308 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
311 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
312 recurse
, pretty
, NULL
, 0);
319 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
322 len
= TYPE_NFIELDS (type
);
323 val
= unpack_long (type
, valaddr
+ embedded_offset
);
324 for (i
= 0; i
< len
; i
++)
327 if (val
== TYPE_FIELD_BITPOS (type
, i
))
334 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
338 print_longest (stream
, 'd', 0, val
);
342 case TYPE_CODE_FLAGS
:
344 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
346 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
352 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
355 /* FIXME, we should consider, at least for ANSI C language, eliminating
356 the distinction made between FUNCs and POINTERs to FUNCs. */
357 fprintf_filtered (stream
, "{");
358 type_print (type
, "", stream
, -1);
359 fprintf_filtered (stream
, "} ");
360 /* Try to print what function it points to, and its address. */
361 print_address_demangle (address
, stream
, demangle
);
365 format
= format
? format
: output_format
;
367 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
370 val
= unpack_long (type
, valaddr
+ embedded_offset
);
372 fputs_filtered ("false", stream
);
374 fputs_filtered ("true", stream
);
377 fputs_filtered ("true (", stream
);
378 fprintf_filtered (stream
, "%ld)", (long int) val
);
383 case TYPE_CODE_RANGE
:
384 /* FIXME: create_range_type does not set the unsigned bit in a
385 range type (I think it probably should copy it from the target
386 type), so we won't print values which are too large to
387 fit in a signed integer correctly. */
388 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
389 print with the target type, though, because the size of our type
390 and the target type might differ). */
394 format
= format
? format
: output_format
;
397 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
401 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
406 format
= format
? format
: output_format
;
409 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
413 val
= unpack_long (type
, valaddr
+ embedded_offset
);
414 if (TYPE_UNSIGNED (type
))
415 fprintf_filtered (stream
, "%u", (unsigned int) val
);
417 fprintf_filtered (stream
, "%d", (int) val
);
418 fputs_filtered (" ", stream
);
419 LA_PRINT_CHAR ((unsigned char) val
, stream
);
426 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
430 print_floating (valaddr
+ embedded_offset
, type
, stream
);
434 case TYPE_CODE_BITSTRING
:
436 elttype
= TYPE_INDEX_TYPE (type
);
437 CHECK_TYPEDEF (elttype
);
438 if (TYPE_STUB (elttype
))
440 fprintf_filtered (stream
, "<incomplete type>");
446 struct type
*range
= elttype
;
447 LONGEST low_bound
, high_bound
;
449 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
453 fputs_filtered ("B'", stream
);
455 fputs_filtered ("[", stream
);
457 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
461 fputs_filtered ("<error value>", stream
);
465 for (i
= low_bound
; i
<= high_bound
; i
++)
467 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
471 goto maybe_bad_bstring
;
474 fprintf_filtered (stream
, "%d", element
);
478 fputs_filtered (", ", stream
);
479 print_type_scalar (range
, i
, stream
);
482 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
485 fputs_filtered ("..", stream
);
486 while (i
+ 1 <= high_bound
487 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
489 print_type_scalar (range
, j
, stream
);
495 fputs_filtered ("'", stream
);
497 fputs_filtered ("]", stream
);
502 fprintf_filtered (stream
, "void");
505 case TYPE_CODE_ERROR
:
506 fprintf_filtered (stream
, "<error type>");
509 case TYPE_CODE_UNDEF
:
510 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
511 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
512 and no complete type for struct foo in that file. */
513 fprintf_filtered (stream
, "<incomplete type>");
517 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
524 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
525 enum val_prettyprint pretty
)
527 struct type
*type
= value_type (val
);
529 /* If it is a pointer, indicate what it points to.
531 Print type also if it is a reference.
533 Object pascal: if it is a member pointer, we will take care
534 of that when we print it. */
535 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
536 TYPE_CODE (type
) == TYPE_CODE_REF
)
538 /* Hack: remove (char *) for char strings. Their
539 type is indicated by the quoted string anyway. */
540 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
541 TYPE_NAME (type
) == NULL
&&
542 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
543 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
549 fprintf_filtered (stream
, "(");
550 type_print (type
, "", stream
, -1);
551 fprintf_filtered (stream
, ") ");
554 return common_val_print (val
, stream
, format
, 1, 0, pretty
);
558 /******************************************************************************
559 Inserted from cp-valprint
560 ******************************************************************************/
562 extern int vtblprint
; /* Controls printing of vtbl's */
563 extern int objectprint
; /* Controls looking up an object's derived type
564 using what we find in its vtables. */
565 static int pascal_static_field_print
; /* Controls printing of static fields. */
567 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
568 struct cmd_list_element
*c
, const char *value
)
570 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
574 static struct obstack dont_print_vb_obstack
;
575 static struct obstack dont_print_statmem_obstack
;
577 static void pascal_object_print_static_field (struct value
*,
578 struct ui_file
*, int, int,
579 enum val_prettyprint
);
581 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
582 CORE_ADDR
, struct ui_file
*,
583 int, int, enum val_prettyprint
,
586 /* It was changed to this after 2.4.5. */
587 const char pascal_vtbl_ptr_name
[] =
588 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
590 /* Return truth value for assertion that TYPE is of the type
591 "pointer to virtual function". */
594 pascal_object_is_vtbl_ptr_type (struct type
*type
)
596 char *typename
= type_name_no_tag (type
);
598 return (typename
!= NULL
599 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
602 /* Return truth value for the assertion that TYPE is of the type
603 "pointer to virtual function table". */
606 pascal_object_is_vtbl_member (struct type
*type
)
608 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
610 type
= TYPE_TARGET_TYPE (type
);
611 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
613 type
= TYPE_TARGET_TYPE (type
);
614 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
615 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
617 /* Virtual functions tables are full of pointers
618 to virtual functions. */
619 return pascal_object_is_vtbl_ptr_type (type
);
626 /* Mutually recursive subroutines of pascal_object_print_value and
627 c_val_print to print out a structure's fields:
628 pascal_object_print_value_fields and pascal_object_print_value.
630 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
631 same meanings as in pascal_object_print_value and c_val_print.
633 DONT_PRINT is an array of baseclass types that we
634 should not print, or zero if called from top level. */
637 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
638 CORE_ADDR address
, struct ui_file
*stream
,
639 int format
, int recurse
,
640 enum val_prettyprint pretty
,
641 struct type
**dont_print_vb
,
642 int dont_print_statmem
)
644 int i
, len
, n_baseclasses
;
645 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
647 CHECK_TYPEDEF (type
);
649 fprintf_filtered (stream
, "{");
650 len
= TYPE_NFIELDS (type
);
651 n_baseclasses
= TYPE_N_BASECLASSES (type
);
653 /* Print out baseclasses such that we don't print
654 duplicates of virtual baseclasses. */
655 if (n_baseclasses
> 0)
656 pascal_object_print_value (type
, valaddr
, address
, stream
,
657 format
, recurse
+ 1, pretty
, dont_print_vb
);
659 if (!len
&& n_baseclasses
== 1)
660 fprintf_filtered (stream
, "<No data fields>");
663 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
666 if (dont_print_statmem
== 0)
668 /* If we're at top level, carve out a completely fresh
669 chunk of the obstack and use that until this particular
670 invocation returns. */
671 obstack_finish (&dont_print_statmem_obstack
);
674 for (i
= n_baseclasses
; i
< len
; i
++)
676 /* If requested, skip printing of static fields. */
677 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
680 fprintf_filtered (stream
, ", ");
681 else if (n_baseclasses
> 0)
685 fprintf_filtered (stream
, "\n");
686 print_spaces_filtered (2 + 2 * recurse
, stream
);
687 fputs_filtered ("members of ", stream
);
688 fputs_filtered (type_name_no_tag (type
), stream
);
689 fputs_filtered (": ", stream
);
696 fprintf_filtered (stream
, "\n");
697 print_spaces_filtered (2 + 2 * recurse
, stream
);
701 wrap_here (n_spaces (2 + 2 * recurse
));
705 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
706 fputs_filtered ("\"( ptr \"", stream
);
708 fputs_filtered ("\"( nodef \"", stream
);
709 if (TYPE_FIELD_STATIC (type
, i
))
710 fputs_filtered ("static ", stream
);
711 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
713 DMGL_PARAMS
| DMGL_ANSI
);
714 fputs_filtered ("\" \"", stream
);
715 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
717 DMGL_PARAMS
| DMGL_ANSI
);
718 fputs_filtered ("\") \"", stream
);
722 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
724 if (TYPE_FIELD_STATIC (type
, i
))
725 fputs_filtered ("static ", stream
);
726 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
728 DMGL_PARAMS
| DMGL_ANSI
);
729 annotate_field_name_end ();
730 fputs_filtered (" = ", stream
);
731 annotate_field_value ();
734 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
738 /* Bitfields require special handling, especially due to byte
740 if (TYPE_FIELD_IGNORE (type
, i
))
742 fputs_filtered ("<optimized out or zero length>", stream
);
746 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
747 unpack_field_as_long (type
, valaddr
, i
));
749 common_val_print (v
, stream
, format
, 0, recurse
+ 1, pretty
);
754 if (TYPE_FIELD_IGNORE (type
, i
))
756 fputs_filtered ("<optimized out or zero length>", stream
);
758 else if (TYPE_FIELD_STATIC (type
, i
))
760 /* struct value *v = value_static_field (type, i); v4.17 specific */
762 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
763 unpack_field_as_long (type
, valaddr
, i
));
766 fputs_filtered ("<optimized out>", stream
);
768 pascal_object_print_static_field (v
, stream
, format
,
769 recurse
+ 1, pretty
);
773 /* val_print (TYPE_FIELD_TYPE (type, i),
774 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
775 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
776 stream, format, 0, recurse + 1, pretty); */
777 val_print (TYPE_FIELD_TYPE (type
, i
),
778 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
779 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
780 stream
, format
, 0, recurse
+ 1, pretty
);
783 annotate_field_end ();
786 if (dont_print_statmem
== 0)
788 /* Free the space used to deal with the printing
789 of the members from top level. */
790 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
791 dont_print_statmem_obstack
= tmp_obstack
;
796 fprintf_filtered (stream
, "\n");
797 print_spaces_filtered (2 * recurse
, stream
);
800 fprintf_filtered (stream
, "}");
803 /* Special val_print routine to avoid printing multiple copies of virtual
807 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
808 CORE_ADDR address
, struct ui_file
*stream
,
809 int format
, int recurse
,
810 enum val_prettyprint pretty
,
811 struct type
**dont_print_vb
)
813 struct type
**last_dont_print
814 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
815 struct obstack tmp_obstack
= dont_print_vb_obstack
;
816 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
818 if (dont_print_vb
== 0)
820 /* If we're at top level, carve out a completely fresh
821 chunk of the obstack and use that until this particular
822 invocation returns. */
823 /* Bump up the high-water mark. Now alpha is omega. */
824 obstack_finish (&dont_print_vb_obstack
);
827 for (i
= 0; i
< n_baseclasses
; i
++)
830 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
831 char *basename
= type_name_no_tag (baseclass
);
832 const gdb_byte
*base_valaddr
;
834 if (BASETYPE_VIA_VIRTUAL (type
, i
))
836 struct type
**first_dont_print
837 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
839 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
843 if (baseclass
== first_dont_print
[j
])
846 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
849 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
853 fprintf_filtered (stream
, "\n");
854 print_spaces_filtered (2 * recurse
, stream
);
856 fputs_filtered ("<", stream
);
857 /* Not sure what the best notation is in the case where there is no
860 fputs_filtered (basename
? basename
: "", stream
);
861 fputs_filtered ("> = ", stream
);
863 /* The virtual base class pointer might have been clobbered by the
864 user program. Make sure that it still points to a valid memory
867 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
869 /* FIXME (alloc): not safe is baseclass is really really big. */
870 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
872 if (target_read_memory (address
+ boffset
, buf
,
873 TYPE_LENGTH (baseclass
)) != 0)
877 base_valaddr
= valaddr
+ boffset
;
880 fprintf_filtered (stream
, "<invalid address>");
882 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
883 stream
, format
, recurse
, pretty
,
884 (struct type
**) obstack_base (&dont_print_vb_obstack
),
886 fputs_filtered (", ", stream
);
892 if (dont_print_vb
== 0)
894 /* Free the space used to deal with the printing
895 of this type from top level. */
896 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
897 /* Reset watermark so that we can continue protecting
898 ourselves from whatever we were protecting ourselves. */
899 dont_print_vb_obstack
= tmp_obstack
;
903 /* Print value of a static member.
904 To avoid infinite recursion when printing a class that contains
905 a static instance of the class, we keep the addresses of all printed
906 static member classes in an obstack and refuse to print them more
909 VAL contains the value to print, STREAM, RECURSE, and PRETTY
910 have the same meanings as in c_val_print. */
913 pascal_object_print_static_field (struct value
*val
,
914 struct ui_file
*stream
, int format
,
915 int recurse
, enum val_prettyprint pretty
)
917 struct type
*type
= value_type (val
);
919 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
921 CORE_ADDR
*first_dont_print
;
925 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
926 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
931 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
933 fputs_filtered ("<same as static member of an already seen type>",
939 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
942 CHECK_TYPEDEF (type
);
943 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
944 stream
, format
, recurse
, pretty
, NULL
, 1);
947 common_val_print (val
, stream
, format
, 0, recurse
, pretty
);
950 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
953 _initialize_pascal_valprint (void)
955 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
956 &pascal_static_field_print
, _("\
957 Set printing of pascal static members."), _("\
958 Show printing of pascal static members."), NULL
,
960 show_pascal_static_field_print
,
961 &setprintlist
, &showprintlist
);
962 /* Turn on printing of static fields. */
963 pascal_static_field_print
= 1;