1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009
4 Free Software Foundation, Inc.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* This file is derived from c-valprint.c */
24 #include "gdb_obstack.h"
27 #include "expression.h"
34 #include "typeprint.h"
40 #include "cp-support.h"
45 /* Print data of type TYPE located at VALADDR (within GDB), which came from
46 the inferior at address ADDRESS, onto stdio stream STREAM according to
47 OPTIONS. The data at VALADDR is in target byte order.
49 If the data are a string pointer, returns the number of string characters
54 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
55 int embedded_offset
, CORE_ADDR address
,
56 struct ui_file
*stream
, int recurse
,
57 const struct value_print_options
*options
)
59 unsigned int i
= 0; /* Number of characters printed */
63 int length_pos
, length_size
, string_pos
;
69 switch (TYPE_CODE (type
))
72 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
74 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
75 eltlen
= TYPE_LENGTH (elttype
);
76 len
= TYPE_LENGTH (type
) / eltlen
;
77 if (options
->prettyprint_arrays
)
79 print_spaces_filtered (2 + 2 * recurse
, stream
);
81 /* For an array of chars, print with string syntax. */
83 && ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
84 || ((current_language
->la_language
== language_pascal
)
85 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
86 && (options
->format
== 0 || options
->format
== 's'))
88 /* If requested, look for the first null char and only print
90 if (options
->stop_print_at_null
)
92 unsigned int temp_len
;
94 /* Look for a NULL char. */
96 (valaddr
+ embedded_offset
)[temp_len
]
97 && temp_len
< len
&& temp_len
< options
->print_max
;
102 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0,
108 fprintf_filtered (stream
, "{");
109 /* If this is a virtual function table, print the 0th
110 entry specially, and the rest of the members normally. */
111 if (pascal_object_is_vtbl_ptr_type (elttype
))
114 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
120 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
121 recurse
, options
, i
);
122 fprintf_filtered (stream
, "}");
126 /* Array of unspecified length: treat like pointer to first elt. */
128 goto print_unpacked_pointer
;
131 if (options
->format
&& options
->format
!= 's')
133 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
137 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
139 /* Print the unmangled name if desired. */
140 /* Print vtable entry - we only get here if we ARE using
141 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
142 /* Extract the address, assume that it is unsigned. */
143 print_address_demangle (extract_unsigned_integer (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
147 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
149 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
150 print_unpacked_pointer
:
151 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
153 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
155 /* Try to print what function it points to. */
156 print_address_demangle (addr
, stream
, demangle
);
157 /* Return value is irrelevant except for string pointers. */
161 if (options
->addressprint
&& options
->format
!= 's')
163 fputs_filtered (paddress (addr
), stream
);
166 /* For a pointer to char or unsigned char, also print the string
167 pointed to, unless pointer is null. */
168 if (TYPE_LENGTH (elttype
) == 1
169 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
170 || TYPE_CODE(elttype
) == TYPE_CODE_CHAR
)
171 && (options
->format
== 0 || options
->format
== 's')
174 /* no wide string yet */
175 i
= val_print_string (addr
, -1, 1, stream
, options
);
177 /* also for pointers to pascal strings */
178 /* Note: this is Free Pascal specific:
179 as GDB does not recognize stabs pascal strings
180 Pascal strings are mapped to records
181 with lowercase names PM */
182 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
183 &string_pos
, &char_size
, NULL
)
186 ULONGEST string_length
;
188 buffer
= xmalloc (length_size
);
189 read_memory (addr
+ length_pos
, buffer
, length_size
);
190 string_length
= extract_unsigned_integer (buffer
, length_size
);
192 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
, options
);
194 else if (pascal_object_is_vtbl_member (type
))
196 /* print vtbl's nicely */
197 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
199 struct minimal_symbol
*msymbol
=
200 lookup_minimal_symbol_by_pc (vt_address
);
201 if ((msymbol
!= NULL
)
202 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
204 fputs_filtered (" <", stream
);
205 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
206 fputs_filtered (">", stream
);
208 if (vt_address
&& options
->vtblprint
)
210 struct value
*vt_val
;
211 struct symbol
*wsym
= (struct symbol
*) NULL
;
213 struct block
*block
= (struct block
*) NULL
;
217 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
218 VAR_DOMAIN
, &is_this_fld
);
222 wtype
= SYMBOL_TYPE (wsym
);
226 wtype
= TYPE_TARGET_TYPE (type
);
228 vt_val
= value_at (wtype
, vt_address
);
229 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
233 fprintf_filtered (stream
, "\n");
234 print_spaces_filtered (2 + 2 * recurse
, stream
);
239 /* Return number of characters printed, including the terminating
240 '\0' if we reached the end. val_print_string takes care including
241 the terminating '\0' if necessary. */
247 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
248 if (options
->addressprint
)
250 fprintf_filtered (stream
, "@");
251 /* Extract the address, assume that it is unsigned. */
252 fputs_filtered (paddress (
253 extract_unsigned_integer (valaddr
+ embedded_offset
,
254 gdbarch_ptr_bit (current_gdbarch
) / HOST_CHAR_BIT
)), stream
);
255 if (options
->deref_ref
)
256 fputs_filtered (": ", stream
);
258 /* De-reference the reference. */
259 if (options
->deref_ref
)
261 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
263 struct value
*deref_val
=
265 (TYPE_TARGET_TYPE (type
),
266 unpack_pointer (type
, valaddr
+ embedded_offset
));
267 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
271 fputs_filtered ("???", stream
);
275 case TYPE_CODE_UNION
:
276 if (recurse
&& !options
->unionprint
)
278 fprintf_filtered (stream
, "{...}");
282 case TYPE_CODE_STRUCT
:
283 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
285 /* Print the unmangled name if desired. */
286 /* Print vtable entry - we only get here if NOT using
287 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
288 /* Extract the address, assume that it is unsigned. */
289 print_address_demangle
290 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
291 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
296 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
297 &string_pos
, &char_size
, NULL
))
299 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
300 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0, options
);
303 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
304 recurse
, options
, NULL
, 0);
311 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
315 len
= TYPE_NFIELDS (type
);
316 val
= unpack_long (type
, valaddr
+ embedded_offset
);
317 for (i
= 0; i
< len
; i
++)
320 if (val
== TYPE_FIELD_BITPOS (type
, i
))
327 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
331 print_longest (stream
, 'd', 0, val
);
335 case TYPE_CODE_FLAGS
:
337 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
340 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
346 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
350 /* FIXME, we should consider, at least for ANSI C language, eliminating
351 the distinction made between FUNCs and POINTERs to FUNCs. */
352 fprintf_filtered (stream
, "{");
353 type_print (type
, "", stream
, -1);
354 fprintf_filtered (stream
, "} ");
355 /* Try to print what function it points to, and its address. */
356 print_address_demangle (address
, stream
, demangle
);
360 if (options
->format
|| options
->output_format
)
362 struct value_print_options opts
= *options
;
363 opts
.format
= (options
->format
? options
->format
364 : options
->output_format
);
365 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
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 if (options
->format
|| options
->output_format
)
396 struct value_print_options opts
= *options
;
397 opts
.format
= (options
->format
? options
->format
398 : options
->output_format
);
399 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
404 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
409 if (options
->format
|| options
->output_format
)
411 struct value_print_options opts
= *options
;
412 opts
.format
= (options
->format
? options
->format
413 : options
->output_format
);
414 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
419 val
= unpack_long (type
, valaddr
+ embedded_offset
);
420 if (TYPE_UNSIGNED (type
))
421 fprintf_filtered (stream
, "%u", (unsigned int) val
);
423 fprintf_filtered (stream
, "%d", (int) val
);
424 fputs_filtered (" ", stream
);
425 LA_PRINT_CHAR ((unsigned char) val
, stream
);
432 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
437 print_floating (valaddr
+ embedded_offset
, type
, stream
);
441 case TYPE_CODE_BITSTRING
:
443 elttype
= TYPE_INDEX_TYPE (type
);
444 CHECK_TYPEDEF (elttype
);
445 if (TYPE_STUB (elttype
))
447 fprintf_filtered (stream
, "<incomplete type>");
453 struct type
*range
= elttype
;
454 LONGEST low_bound
, high_bound
;
456 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
460 fputs_filtered ("B'", stream
);
462 fputs_filtered ("[", stream
);
464 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
468 fputs_filtered ("<error value>", stream
);
472 for (i
= low_bound
; i
<= high_bound
; i
++)
474 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
478 goto maybe_bad_bstring
;
481 fprintf_filtered (stream
, "%d", element
);
485 fputs_filtered (", ", stream
);
486 print_type_scalar (range
, i
, stream
);
489 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
492 fputs_filtered ("..", stream
);
493 while (i
+ 1 <= high_bound
494 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
496 print_type_scalar (range
, j
, stream
);
502 fputs_filtered ("'", stream
);
504 fputs_filtered ("]", stream
);
509 fprintf_filtered (stream
, "void");
512 case TYPE_CODE_ERROR
:
513 fprintf_filtered (stream
, "<error type>");
516 case TYPE_CODE_UNDEF
:
517 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
518 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
519 and no complete type for struct foo in that file. */
520 fprintf_filtered (stream
, "<incomplete type>");
524 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
531 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
532 const struct value_print_options
*options
)
534 struct type
*type
= value_type (val
);
536 /* If it is a pointer, indicate what it points to.
538 Print type also if it is a reference.
540 Object pascal: if it is a member pointer, we will take care
541 of that when we print it. */
542 if (TYPE_CODE (type
) == TYPE_CODE_PTR
543 || TYPE_CODE (type
) == TYPE_CODE_REF
)
545 /* Hack: remove (char *) for char strings. Their
546 type is indicated by the quoted string anyway. */
547 if (TYPE_CODE (type
) == TYPE_CODE_PTR
548 && TYPE_NAME (type
) == NULL
549 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
550 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
556 fprintf_filtered (stream
, "(");
557 type_print (type
, "", stream
, -1);
558 fprintf_filtered (stream
, ") ");
561 return common_val_print (val
, stream
, 0, options
, current_language
);
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,
578 const struct value_print_options
*);
580 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
581 CORE_ADDR
, struct ui_file
*, int,
582 const struct value_print_options
*,
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 OPTIONS 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
,
639 const struct value_print_options
*options
,
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 recurse
+ 1, options
, 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 (!options
->pascal_static_field_print
677 && field_is_static (&TYPE_FIELD (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
));
703 if (options
->inspect_it
)
705 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
706 fputs_filtered ("\"( ptr \"", stream
);
708 fputs_filtered ("\"( nodef \"", stream
);
709 if (field_is_static (&TYPE_FIELD (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 (field_is_static (&TYPE_FIELD (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 (!field_is_static (&TYPE_FIELD (type
, i
))
735 && TYPE_FIELD_PACKED (type
, i
))
739 /* Bitfields require special handling, especially due to byte
741 if (TYPE_FIELD_IGNORE (type
, i
))
743 fputs_filtered ("<optimized out or zero length>", stream
);
747 struct value_print_options opts
= *options
;
748 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
749 unpack_field_as_long (type
, valaddr
, i
));
752 common_val_print (v
, stream
, recurse
+ 1, &opts
,
758 if (TYPE_FIELD_IGNORE (type
, i
))
760 fputs_filtered ("<optimized out or zero length>", stream
);
762 else if (field_is_static (&TYPE_FIELD (type
, i
)))
764 /* struct value *v = value_static_field (type, i); v4.17 specific */
766 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
767 unpack_field_as_long (type
, valaddr
, i
));
770 fputs_filtered ("<optimized out>", stream
);
772 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
777 struct value_print_options opts
= *options
;
779 /* val_print (TYPE_FIELD_TYPE (type, i),
780 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
781 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
782 stream, format, 0, recurse + 1, pretty); */
783 val_print (TYPE_FIELD_TYPE (type
, i
),
784 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
785 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
786 stream
, recurse
+ 1, &opts
,
790 annotate_field_end ();
793 if (dont_print_statmem
== 0)
795 /* Free the space used to deal with the printing
796 of the members from top level. */
797 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
798 dont_print_statmem_obstack
= tmp_obstack
;
803 fprintf_filtered (stream
, "\n");
804 print_spaces_filtered (2 * recurse
, stream
);
807 fprintf_filtered (stream
, "}");
810 /* Special val_print routine to avoid printing multiple copies of virtual
814 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
815 CORE_ADDR address
, struct ui_file
*stream
,
817 const struct value_print_options
*options
,
818 struct type
**dont_print_vb
)
820 struct type
**last_dont_print
821 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
822 struct obstack tmp_obstack
= dont_print_vb_obstack
;
823 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
825 if (dont_print_vb
== 0)
827 /* If we're at top level, carve out a completely fresh
828 chunk of the obstack and use that until this particular
829 invocation returns. */
830 /* Bump up the high-water mark. Now alpha is omega. */
831 obstack_finish (&dont_print_vb_obstack
);
834 for (i
= 0; i
< n_baseclasses
; i
++)
837 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
838 char *basename
= type_name_no_tag (baseclass
);
839 const gdb_byte
*base_valaddr
;
841 if (BASETYPE_VIA_VIRTUAL (type
, i
))
843 struct type
**first_dont_print
844 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
846 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
850 if (baseclass
== first_dont_print
[j
])
853 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
856 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
860 fprintf_filtered (stream
, "\n");
861 print_spaces_filtered (2 * recurse
, stream
);
863 fputs_filtered ("<", stream
);
864 /* Not sure what the best notation is in the case where there is no
867 fputs_filtered (basename
? basename
: "", stream
);
868 fputs_filtered ("> = ", stream
);
870 /* The virtual base class pointer might have been clobbered by the
871 user program. Make sure that it still points to a valid memory
874 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
876 /* FIXME (alloc): not safe is baseclass is really really big. */
877 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
879 if (target_read_memory (address
+ boffset
, buf
,
880 TYPE_LENGTH (baseclass
)) != 0)
884 base_valaddr
= valaddr
+ boffset
;
887 fprintf_filtered (stream
, "<invalid address>");
889 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
890 stream
, recurse
, options
,
891 (struct type
**) obstack_base (&dont_print_vb_obstack
),
893 fputs_filtered (", ", stream
);
899 if (dont_print_vb
== 0)
901 /* Free the space used to deal with the printing
902 of this type from top level. */
903 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
904 /* Reset watermark so that we can continue protecting
905 ourselves from whatever we were protecting ourselves. */
906 dont_print_vb_obstack
= tmp_obstack
;
910 /* Print value of a static member.
911 To avoid infinite recursion when printing a class that contains
912 a static instance of the class, we keep the addresses of all printed
913 static member classes in an obstack and refuse to print them more
916 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
917 have the same meanings as in c_val_print. */
920 pascal_object_print_static_field (struct value
*val
,
921 struct ui_file
*stream
,
923 const struct value_print_options
*options
)
925 struct type
*type
= value_type (val
);
926 struct value_print_options opts
;
928 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
930 CORE_ADDR
*first_dont_print
;
934 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
935 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
940 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
942 fputs_filtered ("<same as static member of an already seen type>",
948 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
951 CHECK_TYPEDEF (type
);
952 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
953 stream
, recurse
, options
, NULL
, 1);
959 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
962 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
965 _initialize_pascal_valprint (void)
967 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
968 &user_print_options
.pascal_static_field_print
, _("\
969 Set printing of pascal static members."), _("\
970 Show printing of pascal static members."), NULL
,
972 show_pascal_static_field_print
,
973 &setprintlist
, &showprintlist
);