1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008
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_pascal
)
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 fputs_filtered (paddress (addr
), 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 || TYPE_CODE(elttype
) == TYPE_CODE_CHAR
)
175 && (format
== 0 || format
== 's')
178 /* no wide string yet */
179 i
= val_print_string (addr
, -1, 1, stream
);
181 /* also for pointers to pascal strings */
182 /* Note: this is Free Pascal specific:
183 as GDB does not recognize stabs pascal strings
184 Pascal strings are mapped to records
185 with lowercase names PM */
186 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
187 &string_pos
, &char_size
, NULL
)
190 ULONGEST string_length
;
192 buffer
= xmalloc (length_size
);
193 read_memory (addr
+ length_pos
, buffer
, length_size
);
194 string_length
= extract_unsigned_integer (buffer
, length_size
);
196 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
198 else if (pascal_object_is_vtbl_member (type
))
200 /* print vtbl's nicely */
201 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
203 struct minimal_symbol
*msymbol
=
204 lookup_minimal_symbol_by_pc (vt_address
);
205 if ((msymbol
!= NULL
)
206 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
208 fputs_filtered (" <", stream
);
209 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
210 fputs_filtered (">", stream
);
212 if (vt_address
&& vtblprint
)
214 struct value
*vt_val
;
215 struct symbol
*wsym
= (struct symbol
*) NULL
;
217 struct block
*block
= (struct block
*) NULL
;
221 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
222 VAR_DOMAIN
, &is_this_fld
);
226 wtype
= SYMBOL_TYPE (wsym
);
230 wtype
= TYPE_TARGET_TYPE (type
);
232 vt_val
= value_at (wtype
, vt_address
);
233 common_val_print (vt_val
, stream
, format
, deref_ref
,
234 recurse
+ 1, pretty
, current_language
);
237 fprintf_filtered (stream
, "\n");
238 print_spaces_filtered (2 + 2 * recurse
, stream
);
243 /* Return number of characters printed, including the terminating
244 '\0' if we reached the end. val_print_string takes care including
245 the terminating '\0' if necessary. */
251 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
254 fprintf_filtered (stream
, "@");
255 /* Extract the address, assume that it is unsigned. */
256 fputs_filtered (paddress (
257 extract_unsigned_integer (valaddr
+ embedded_offset
,
258 gdbarch_ptr_bit (current_gdbarch
) / HOST_CHAR_BIT
)), stream
);
260 fputs_filtered (": ", stream
);
262 /* De-reference the reference. */
265 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
267 struct value
*deref_val
=
269 (TYPE_TARGET_TYPE (type
),
270 unpack_pointer (type
, valaddr
+ embedded_offset
));
271 common_val_print (deref_val
, stream
, format
, deref_ref
,
272 recurse
+ 1, pretty
, current_language
);
275 fputs_filtered ("???", stream
);
279 case TYPE_CODE_UNION
:
280 if (recurse
&& !unionprint
)
282 fprintf_filtered (stream
, "{...}");
286 case TYPE_CODE_STRUCT
:
287 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
289 /* Print the unmangled name if desired. */
290 /* Print vtable entry - we only get here if NOT using
291 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
292 /* Extract the address, assume that it is unsigned. */
293 print_address_demangle
294 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
295 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
300 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
301 &string_pos
, &char_size
, NULL
))
303 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
304 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
307 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
308 recurse
, pretty
, NULL
, 0);
315 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
318 len
= TYPE_NFIELDS (type
);
319 val
= unpack_long (type
, valaddr
+ embedded_offset
);
320 for (i
= 0; i
< len
; i
++)
323 if (val
== TYPE_FIELD_BITPOS (type
, i
))
330 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
334 print_longest (stream
, 'd', 0, val
);
338 case TYPE_CODE_FLAGS
:
340 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
342 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
348 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
351 /* FIXME, we should consider, at least for ANSI C language, eliminating
352 the distinction made between FUNCs and POINTERs to FUNCs. */
353 fprintf_filtered (stream
, "{");
354 type_print (type
, "", stream
, -1);
355 fprintf_filtered (stream
, "} ");
356 /* Try to print what function it points to, and its address. */
357 print_address_demangle (address
, stream
, demangle
);
361 format
= format
? format
: output_format
;
363 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
366 val
= unpack_long (type
, valaddr
+ embedded_offset
);
368 fputs_filtered ("false", stream
);
370 fputs_filtered ("true", stream
);
373 fputs_filtered ("true (", stream
);
374 fprintf_filtered (stream
, "%ld)", (long int) val
);
379 case TYPE_CODE_RANGE
:
380 /* FIXME: create_range_type does not set the unsigned bit in a
381 range type (I think it probably should copy it from the target
382 type), so we won't print values which are too large to
383 fit in a signed integer correctly. */
384 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
385 print with the target type, though, because the size of our type
386 and the target type might differ). */
390 format
= format
? format
: output_format
;
393 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
397 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
402 format
= format
? format
: output_format
;
405 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
409 val
= unpack_long (type
, valaddr
+ embedded_offset
);
410 if (TYPE_UNSIGNED (type
))
411 fprintf_filtered (stream
, "%u", (unsigned int) val
);
413 fprintf_filtered (stream
, "%d", (int) val
);
414 fputs_filtered (" ", stream
);
415 LA_PRINT_CHAR ((unsigned char) val
, stream
);
422 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
426 print_floating (valaddr
+ embedded_offset
, type
, stream
);
430 case TYPE_CODE_BITSTRING
:
432 elttype
= TYPE_INDEX_TYPE (type
);
433 CHECK_TYPEDEF (elttype
);
434 if (TYPE_STUB (elttype
))
436 fprintf_filtered (stream
, "<incomplete type>");
442 struct type
*range
= elttype
;
443 LONGEST low_bound
, high_bound
;
445 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
449 fputs_filtered ("B'", stream
);
451 fputs_filtered ("[", stream
);
453 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
457 fputs_filtered ("<error value>", stream
);
461 for (i
= low_bound
; i
<= high_bound
; i
++)
463 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
467 goto maybe_bad_bstring
;
470 fprintf_filtered (stream
, "%d", element
);
474 fputs_filtered (", ", stream
);
475 print_type_scalar (range
, i
, stream
);
478 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
481 fputs_filtered ("..", stream
);
482 while (i
+ 1 <= high_bound
483 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
485 print_type_scalar (range
, j
, stream
);
491 fputs_filtered ("'", stream
);
493 fputs_filtered ("]", stream
);
498 fprintf_filtered (stream
, "void");
501 case TYPE_CODE_ERROR
:
502 fprintf_filtered (stream
, "<error type>");
505 case TYPE_CODE_UNDEF
:
506 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
507 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
508 and no complete type for struct foo in that file. */
509 fprintf_filtered (stream
, "<incomplete type>");
513 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
520 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
521 enum val_prettyprint pretty
)
523 struct type
*type
= value_type (val
);
525 /* If it is a pointer, indicate what it points to.
527 Print type also if it is a reference.
529 Object pascal: if it is a member pointer, we will take care
530 of that when we print it. */
531 if (TYPE_CODE (type
) == TYPE_CODE_PTR
532 || TYPE_CODE (type
) == TYPE_CODE_REF
)
534 /* Hack: remove (char *) for char strings. Their
535 type is indicated by the quoted string anyway. */
536 if (TYPE_CODE (type
) == TYPE_CODE_PTR
537 && TYPE_NAME (type
) == NULL
538 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
539 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
545 fprintf_filtered (stream
, "(");
546 type_print (type
, "", stream
, -1);
547 fprintf_filtered (stream
, ") ");
550 return common_val_print (val
, stream
, format
, 1, 0, pretty
,
555 /******************************************************************************
556 Inserted from cp-valprint
557 ******************************************************************************/
559 extern int vtblprint
; /* Controls printing of vtbl's */
560 extern int objectprint
; /* Controls looking up an object's derived type
561 using what we find in its vtables. */
562 static int pascal_static_field_print
; /* Controls printing of static fields. */
564 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
565 struct cmd_list_element
*c
, const char *value
)
567 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
571 static struct obstack dont_print_vb_obstack
;
572 static struct obstack dont_print_statmem_obstack
;
574 static void pascal_object_print_static_field (struct value
*,
575 struct ui_file
*, int, int,
576 enum val_prettyprint
);
578 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
579 CORE_ADDR
, struct ui_file
*,
580 int, int, enum val_prettyprint
,
583 /* It was changed to this after 2.4.5. */
584 const char pascal_vtbl_ptr_name
[] =
585 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
587 /* Return truth value for assertion that TYPE is of the type
588 "pointer to virtual function". */
591 pascal_object_is_vtbl_ptr_type (struct type
*type
)
593 char *typename
= type_name_no_tag (type
);
595 return (typename
!= NULL
596 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
599 /* Return truth value for the assertion that TYPE is of the type
600 "pointer to virtual function table". */
603 pascal_object_is_vtbl_member (struct type
*type
)
605 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
607 type
= TYPE_TARGET_TYPE (type
);
608 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
610 type
= TYPE_TARGET_TYPE (type
);
611 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
612 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
614 /* Virtual functions tables are full of pointers
615 to virtual functions. */
616 return pascal_object_is_vtbl_ptr_type (type
);
623 /* Mutually recursive subroutines of pascal_object_print_value and
624 c_val_print to print out a structure's fields:
625 pascal_object_print_value_fields and pascal_object_print_value.
627 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
628 same meanings as in pascal_object_print_value and c_val_print.
630 DONT_PRINT is an array of baseclass types that we
631 should not print, or zero if called from top level. */
634 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
635 CORE_ADDR address
, struct ui_file
*stream
,
636 int format
, int recurse
,
637 enum val_prettyprint pretty
,
638 struct type
**dont_print_vb
,
639 int dont_print_statmem
)
641 int i
, len
, n_baseclasses
;
642 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
644 CHECK_TYPEDEF (type
);
646 fprintf_filtered (stream
, "{");
647 len
= TYPE_NFIELDS (type
);
648 n_baseclasses
= TYPE_N_BASECLASSES (type
);
650 /* Print out baseclasses such that we don't print
651 duplicates of virtual baseclasses. */
652 if (n_baseclasses
> 0)
653 pascal_object_print_value (type
, valaddr
, address
, stream
,
654 format
, recurse
+ 1, pretty
, dont_print_vb
);
656 if (!len
&& n_baseclasses
== 1)
657 fprintf_filtered (stream
, "<No data fields>");
660 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
663 if (dont_print_statmem
== 0)
665 /* If we're at top level, carve out a completely fresh
666 chunk of the obstack and use that until this particular
667 invocation returns. */
668 obstack_finish (&dont_print_statmem_obstack
);
671 for (i
= n_baseclasses
; i
< len
; i
++)
673 /* If requested, skip printing of static fields. */
674 if (!pascal_static_field_print
675 && field_is_static (&TYPE_FIELD (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 (field_is_static (&TYPE_FIELD (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 (field_is_static (&TYPE_FIELD (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 (!field_is_static (&TYPE_FIELD (type
, i
))
733 && TYPE_FIELD_PACKED (type
, i
))
737 /* Bitfields require special handling, especially due to byte
739 if (TYPE_FIELD_IGNORE (type
, i
))
741 fputs_filtered ("<optimized out or zero length>", stream
);
745 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
746 unpack_field_as_long (type
, valaddr
, i
));
748 common_val_print (v
, stream
, format
, 0, recurse
+ 1,
749 pretty
, current_language
);
754 if (TYPE_FIELD_IGNORE (type
, i
))
756 fputs_filtered ("<optimized out or zero length>", stream
);
758 else if (field_is_static (&TYPE_FIELD (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
,
784 annotate_field_end ();
787 if (dont_print_statmem
== 0)
789 /* Free the space used to deal with the printing
790 of the members from top level. */
791 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
792 dont_print_statmem_obstack
= tmp_obstack
;
797 fprintf_filtered (stream
, "\n");
798 print_spaces_filtered (2 * recurse
, stream
);
801 fprintf_filtered (stream
, "}");
804 /* Special val_print routine to avoid printing multiple copies of virtual
808 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
809 CORE_ADDR address
, struct ui_file
*stream
,
810 int format
, int recurse
,
811 enum val_prettyprint pretty
,
812 struct type
**dont_print_vb
)
814 struct type
**last_dont_print
815 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
816 struct obstack tmp_obstack
= dont_print_vb_obstack
;
817 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
819 if (dont_print_vb
== 0)
821 /* If we're at top level, carve out a completely fresh
822 chunk of the obstack and use that until this particular
823 invocation returns. */
824 /* Bump up the high-water mark. Now alpha is omega. */
825 obstack_finish (&dont_print_vb_obstack
);
828 for (i
= 0; i
< n_baseclasses
; i
++)
831 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
832 char *basename
= type_name_no_tag (baseclass
);
833 const gdb_byte
*base_valaddr
;
835 if (BASETYPE_VIA_VIRTUAL (type
, i
))
837 struct type
**first_dont_print
838 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
840 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
844 if (baseclass
== first_dont_print
[j
])
847 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
850 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
854 fprintf_filtered (stream
, "\n");
855 print_spaces_filtered (2 * recurse
, stream
);
857 fputs_filtered ("<", stream
);
858 /* Not sure what the best notation is in the case where there is no
861 fputs_filtered (basename
? basename
: "", stream
);
862 fputs_filtered ("> = ", stream
);
864 /* The virtual base class pointer might have been clobbered by the
865 user program. Make sure that it still points to a valid memory
868 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
870 /* FIXME (alloc): not safe is baseclass is really really big. */
871 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
873 if (target_read_memory (address
+ boffset
, buf
,
874 TYPE_LENGTH (baseclass
)) != 0)
878 base_valaddr
= valaddr
+ boffset
;
881 fprintf_filtered (stream
, "<invalid address>");
883 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
884 stream
, format
, recurse
, pretty
,
885 (struct type
**) obstack_base (&dont_print_vb_obstack
),
887 fputs_filtered (", ", stream
);
893 if (dont_print_vb
== 0)
895 /* Free the space used to deal with the printing
896 of this type from top level. */
897 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
898 /* Reset watermark so that we can continue protecting
899 ourselves from whatever we were protecting ourselves. */
900 dont_print_vb_obstack
= tmp_obstack
;
904 /* Print value of a static member.
905 To avoid infinite recursion when printing a class that contains
906 a static instance of the class, we keep the addresses of all printed
907 static member classes in an obstack and refuse to print them more
910 VAL contains the value to print, STREAM, RECURSE, and PRETTY
911 have the same meanings as in c_val_print. */
914 pascal_object_print_static_field (struct value
*val
,
915 struct ui_file
*stream
, int format
,
916 int recurse
, enum val_prettyprint pretty
)
918 struct type
*type
= value_type (val
);
920 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
922 CORE_ADDR
*first_dont_print
;
926 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
927 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
932 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
934 fputs_filtered ("<same as static member of an already seen type>",
940 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
943 CHECK_TYPEDEF (type
);
944 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
945 stream
, format
, recurse
, pretty
, NULL
, 1);
948 common_val_print (val
, stream
, format
, 0, recurse
, pretty
,
952 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
955 _initialize_pascal_valprint (void)
957 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
958 &pascal_static_field_print
, _("\
959 Set printing of pascal static members."), _("\
960 Show printing of pascal static members."), NULL
,
962 show_pascal_static_field_print
,
963 &setprintlist
, &showprintlist
);
964 /* Turn on printing of static fields. */
965 pascal_static_field_print
= 1;