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 TARGET_PTR_BIT
/ HOST_CHAR_BIT
),
262 fputs_filtered (": ", stream
);
264 /* De-reference the reference. */
267 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
269 struct value
*deref_val
=
271 (TYPE_TARGET_TYPE (type
),
272 unpack_pointer (lookup_pointer_type (builtin_type_void
),
273 valaddr
+ embedded_offset
));
274 common_val_print (deref_val
, stream
, format
, deref_ref
,
275 recurse
+ 1, pretty
);
278 fputs_filtered ("???", stream
);
282 case TYPE_CODE_UNION
:
283 if (recurse
&& !unionprint
)
285 fprintf_filtered (stream
, "{...}");
289 case TYPE_CODE_STRUCT
:
290 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
292 /* Print the unmangled name if desired. */
293 /* Print vtable entry - we only get here if NOT using
294 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
295 /* Extract the address, assume that it is unsigned. */
296 print_address_demangle
297 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
298 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
303 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
304 &string_pos
, &char_size
, NULL
))
306 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
307 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
310 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
311 recurse
, pretty
, NULL
, 0);
318 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
321 len
= TYPE_NFIELDS (type
);
322 val
= unpack_long (type
, valaddr
+ embedded_offset
);
323 for (i
= 0; i
< len
; i
++)
326 if (val
== TYPE_FIELD_BITPOS (type
, i
))
333 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
337 print_longest (stream
, 'd', 0, val
);
341 case TYPE_CODE_FLAGS
:
343 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
345 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
351 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
354 /* FIXME, we should consider, at least for ANSI C language, eliminating
355 the distinction made between FUNCs and POINTERs to FUNCs. */
356 fprintf_filtered (stream
, "{");
357 type_print (type
, "", stream
, -1);
358 fprintf_filtered (stream
, "} ");
359 /* Try to print what function it points to, and its address. */
360 print_address_demangle (address
, stream
, demangle
);
364 format
= format
? format
: output_format
;
366 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
369 val
= unpack_long (type
, valaddr
+ embedded_offset
);
371 fputs_filtered ("false", stream
);
373 fputs_filtered ("true", stream
);
376 fputs_filtered ("true (", stream
);
377 fprintf_filtered (stream
, "%ld)", (long int) val
);
382 case TYPE_CODE_RANGE
:
383 /* FIXME: create_range_type does not set the unsigned bit in a
384 range type (I think it probably should copy it from the target
385 type), so we won't print values which are too large to
386 fit in a signed integer correctly. */
387 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
388 print with the target type, though, because the size of our type
389 and the target type might differ). */
393 format
= format
? format
: output_format
;
396 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
400 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
405 format
= format
? format
: output_format
;
408 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
412 val
= unpack_long (type
, valaddr
+ embedded_offset
);
413 if (TYPE_UNSIGNED (type
))
414 fprintf_filtered (stream
, "%u", (unsigned int) val
);
416 fprintf_filtered (stream
, "%d", (int) val
);
417 fputs_filtered (" ", stream
);
418 LA_PRINT_CHAR ((unsigned char) val
, stream
);
425 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
429 print_floating (valaddr
+ embedded_offset
, type
, stream
);
433 case TYPE_CODE_BITSTRING
:
435 elttype
= TYPE_INDEX_TYPE (type
);
436 CHECK_TYPEDEF (elttype
);
437 if (TYPE_STUB (elttype
))
439 fprintf_filtered (stream
, "<incomplete type>");
445 struct type
*range
= elttype
;
446 LONGEST low_bound
, high_bound
;
448 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
452 fputs_filtered ("B'", stream
);
454 fputs_filtered ("[", stream
);
456 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
460 fputs_filtered ("<error value>", stream
);
464 for (i
= low_bound
; i
<= high_bound
; i
++)
466 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
470 goto maybe_bad_bstring
;
473 fprintf_filtered (stream
, "%d", element
);
477 fputs_filtered (", ", stream
);
478 print_type_scalar (range
, i
, stream
);
481 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
484 fputs_filtered ("..", stream
);
485 while (i
+ 1 <= high_bound
486 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
488 print_type_scalar (range
, j
, stream
);
494 fputs_filtered ("'", stream
);
496 fputs_filtered ("]", stream
);
501 fprintf_filtered (stream
, "void");
504 case TYPE_CODE_ERROR
:
505 fprintf_filtered (stream
, "<error type>");
508 case TYPE_CODE_UNDEF
:
509 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
510 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
511 and no complete type for struct foo in that file. */
512 fprintf_filtered (stream
, "<incomplete type>");
516 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
523 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
524 enum val_prettyprint pretty
)
526 struct type
*type
= value_type (val
);
528 /* If it is a pointer, indicate what it points to.
530 Print type also if it is a reference.
532 Object pascal: if it is a member pointer, we will take care
533 of that when we print it. */
534 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
535 TYPE_CODE (type
) == TYPE_CODE_REF
)
537 /* Hack: remove (char *) for char strings. Their
538 type is indicated by the quoted string anyway. */
539 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
540 TYPE_NAME (type
) == NULL
&&
541 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
542 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
548 fprintf_filtered (stream
, "(");
549 type_print (type
, "", stream
, -1);
550 fprintf_filtered (stream
, ") ");
553 return common_val_print (val
, stream
, format
, 1, 0, pretty
);
557 /******************************************************************************
558 Inserted from cp-valprint
559 ******************************************************************************/
561 extern int vtblprint
; /* Controls printing of vtbl's */
562 extern int objectprint
; /* Controls looking up an object's derived type
563 using what we find in its vtables. */
564 static int pascal_static_field_print
; /* Controls printing of static fields. */
566 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
567 struct cmd_list_element
*c
, const char *value
)
569 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
573 static struct obstack dont_print_vb_obstack
;
574 static struct obstack dont_print_statmem_obstack
;
576 static void pascal_object_print_static_field (struct value
*,
577 struct ui_file
*, int, int,
578 enum val_prettyprint
);
580 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
581 CORE_ADDR
, struct ui_file
*,
582 int, int, enum val_prettyprint
,
585 /* It was changed to this after 2.4.5. */
586 const char pascal_vtbl_ptr_name
[] =
587 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
589 /* Return truth value for assertion that TYPE is of the type
590 "pointer to virtual function". */
593 pascal_object_is_vtbl_ptr_type (struct type
*type
)
595 char *typename
= type_name_no_tag (type
);
597 return (typename
!= NULL
598 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
601 /* Return truth value for the assertion that TYPE is of the type
602 "pointer to virtual function table". */
605 pascal_object_is_vtbl_member (struct type
*type
)
607 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
609 type
= TYPE_TARGET_TYPE (type
);
610 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
612 type
= TYPE_TARGET_TYPE (type
);
613 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
614 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
616 /* Virtual functions tables are full of pointers
617 to virtual functions. */
618 return pascal_object_is_vtbl_ptr_type (type
);
625 /* Mutually recursive subroutines of pascal_object_print_value and
626 c_val_print to print out a structure's fields:
627 pascal_object_print_value_fields and pascal_object_print_value.
629 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
630 same meanings as in pascal_object_print_value and c_val_print.
632 DONT_PRINT is an array of baseclass types that we
633 should not print, or zero if called from top level. */
636 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
637 CORE_ADDR address
, struct ui_file
*stream
,
638 int format
, int recurse
,
639 enum val_prettyprint pretty
,
640 struct type
**dont_print_vb
,
641 int dont_print_statmem
)
643 int i
, len
, n_baseclasses
;
644 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
646 CHECK_TYPEDEF (type
);
648 fprintf_filtered (stream
, "{");
649 len
= TYPE_NFIELDS (type
);
650 n_baseclasses
= TYPE_N_BASECLASSES (type
);
652 /* Print out baseclasses such that we don't print
653 duplicates of virtual baseclasses. */
654 if (n_baseclasses
> 0)
655 pascal_object_print_value (type
, valaddr
, address
, stream
,
656 format
, recurse
+ 1, pretty
, dont_print_vb
);
658 if (!len
&& n_baseclasses
== 1)
659 fprintf_filtered (stream
, "<No data fields>");
662 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
665 if (dont_print_statmem
== 0)
667 /* If we're at top level, carve out a completely fresh
668 chunk of the obstack and use that until this particular
669 invocation returns. */
670 obstack_finish (&dont_print_statmem_obstack
);
673 for (i
= n_baseclasses
; i
< len
; i
++)
675 /* If requested, skip printing of static fields. */
676 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
679 fprintf_filtered (stream
, ", ");
680 else if (n_baseclasses
> 0)
684 fprintf_filtered (stream
, "\n");
685 print_spaces_filtered (2 + 2 * recurse
, stream
);
686 fputs_filtered ("members of ", stream
);
687 fputs_filtered (type_name_no_tag (type
), stream
);
688 fputs_filtered (": ", stream
);
695 fprintf_filtered (stream
, "\n");
696 print_spaces_filtered (2 + 2 * recurse
, stream
);
700 wrap_here (n_spaces (2 + 2 * recurse
));
704 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
705 fputs_filtered ("\"( ptr \"", stream
);
707 fputs_filtered ("\"( nodef \"", stream
);
708 if (TYPE_FIELD_STATIC (type
, i
))
709 fputs_filtered ("static ", stream
);
710 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
712 DMGL_PARAMS
| DMGL_ANSI
);
713 fputs_filtered ("\" \"", stream
);
714 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
716 DMGL_PARAMS
| DMGL_ANSI
);
717 fputs_filtered ("\") \"", stream
);
721 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
723 if (TYPE_FIELD_STATIC (type
, i
))
724 fputs_filtered ("static ", stream
);
725 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
727 DMGL_PARAMS
| DMGL_ANSI
);
728 annotate_field_name_end ();
729 fputs_filtered (" = ", stream
);
730 annotate_field_value ();
733 if (!TYPE_FIELD_STATIC (type
, i
) && 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, pretty
);
753 if (TYPE_FIELD_IGNORE (type
, i
))
755 fputs_filtered ("<optimized out or zero length>", stream
);
757 else if (TYPE_FIELD_STATIC (type
, i
))
759 /* struct value *v = value_static_field (type, i); v4.17 specific */
761 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
762 unpack_field_as_long (type
, valaddr
, i
));
765 fputs_filtered ("<optimized out>", stream
);
767 pascal_object_print_static_field (v
, stream
, format
,
768 recurse
+ 1, pretty
);
772 /* val_print (TYPE_FIELD_TYPE (type, i),
773 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
774 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
775 stream, format, 0, recurse + 1, pretty); */
776 val_print (TYPE_FIELD_TYPE (type
, i
),
777 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
778 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
779 stream
, format
, 0, recurse
+ 1, pretty
);
782 annotate_field_end ();
785 if (dont_print_statmem
== 0)
787 /* Free the space used to deal with the printing
788 of the members from top level. */
789 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
790 dont_print_statmem_obstack
= tmp_obstack
;
795 fprintf_filtered (stream
, "\n");
796 print_spaces_filtered (2 * recurse
, stream
);
799 fprintf_filtered (stream
, "}");
802 /* Special val_print routine to avoid printing multiple copies of virtual
806 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
807 CORE_ADDR address
, struct ui_file
*stream
,
808 int format
, int recurse
,
809 enum val_prettyprint pretty
,
810 struct type
**dont_print_vb
)
812 struct type
**last_dont_print
813 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
814 struct obstack tmp_obstack
= dont_print_vb_obstack
;
815 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
817 if (dont_print_vb
== 0)
819 /* If we're at top level, carve out a completely fresh
820 chunk of the obstack and use that until this particular
821 invocation returns. */
822 /* Bump up the high-water mark. Now alpha is omega. */
823 obstack_finish (&dont_print_vb_obstack
);
826 for (i
= 0; i
< n_baseclasses
; i
++)
829 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
830 char *basename
= type_name_no_tag (baseclass
);
831 const gdb_byte
*base_valaddr
;
833 if (BASETYPE_VIA_VIRTUAL (type
, i
))
835 struct type
**first_dont_print
836 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
838 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
842 if (baseclass
== first_dont_print
[j
])
845 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
848 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
852 fprintf_filtered (stream
, "\n");
853 print_spaces_filtered (2 * recurse
, stream
);
855 fputs_filtered ("<", stream
);
856 /* Not sure what the best notation is in the case where there is no
859 fputs_filtered (basename
? basename
: "", stream
);
860 fputs_filtered ("> = ", stream
);
862 /* The virtual base class pointer might have been clobbered by the
863 user program. Make sure that it still points to a valid memory
866 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
868 /* FIXME (alloc): not safe is baseclass is really really big. */
869 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
871 if (target_read_memory (address
+ boffset
, buf
,
872 TYPE_LENGTH (baseclass
)) != 0)
876 base_valaddr
= valaddr
+ boffset
;
879 fprintf_filtered (stream
, "<invalid address>");
881 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
882 stream
, format
, recurse
, pretty
,
883 (struct type
**) obstack_base (&dont_print_vb_obstack
),
885 fputs_filtered (", ", stream
);
891 if (dont_print_vb
== 0)
893 /* Free the space used to deal with the printing
894 of this type from top level. */
895 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
896 /* Reset watermark so that we can continue protecting
897 ourselves from whatever we were protecting ourselves. */
898 dont_print_vb_obstack
= tmp_obstack
;
902 /* Print value of a static member.
903 To avoid infinite recursion when printing a class that contains
904 a static instance of the class, we keep the addresses of all printed
905 static member classes in an obstack and refuse to print them more
908 VAL contains the value to print, STREAM, RECURSE, and PRETTY
909 have the same meanings as in c_val_print. */
912 pascal_object_print_static_field (struct value
*val
,
913 struct ui_file
*stream
, int format
,
914 int recurse
, enum val_prettyprint pretty
)
916 struct type
*type
= value_type (val
);
918 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
920 CORE_ADDR
*first_dont_print
;
924 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
925 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
930 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
932 fputs_filtered ("<same as static member of an already seen type>",
938 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
941 CHECK_TYPEDEF (type
);
942 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
943 stream
, format
, recurse
, pretty
, NULL
, 1);
946 common_val_print (val
, stream
, format
, 0, recurse
, pretty
);
949 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
952 _initialize_pascal_valprint (void)
954 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
955 &pascal_static_field_print
, _("\
956 Set printing of pascal static members."), _("\
957 Show printing of pascal static members."), NULL
,
959 show_pascal_static_field_print
,
960 &setprintlist
, &showprintlist
);
961 /* Turn on printing of static fields. */
962 pascal_static_field_print
= 1;