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 struct gdbarch
*gdbarch
= get_type_arch (type
);
60 unsigned int i
= 0; /* Number of characters printed */
64 int length_pos
, length_size
, string_pos
;
65 struct type
*char_type
;
70 switch (TYPE_CODE (type
))
73 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
75 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
76 eltlen
= TYPE_LENGTH (elttype
);
77 len
= TYPE_LENGTH (type
) / eltlen
;
78 if (options
->prettyprint_arrays
)
80 print_spaces_filtered (2 + 2 * recurse
, stream
);
82 /* For an array of chars, print with string syntax. */
83 if ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
84 && ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
85 || ((current_language
->la_language
== language_pascal
)
86 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
87 && (options
->format
== 0 || options
->format
== 's'))
89 /* If requested, look for the first null char and only print
91 if (options
->stop_print_at_null
)
93 unsigned int temp_len
;
95 /* Look for a NULL char. */
97 extract_unsigned_integer (valaddr
+ embedded_offset
+
98 temp_len
* eltlen
, eltlen
)
99 && temp_len
< len
&& temp_len
< options
->print_max
;
104 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
105 valaddr
+ embedded_offset
, len
, 0,
111 fprintf_filtered (stream
, "{");
112 /* If this is a virtual function table, print the 0th
113 entry specially, and the rest of the members normally. */
114 if (pascal_object_is_vtbl_ptr_type (elttype
))
117 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
123 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
124 recurse
, options
, i
);
125 fprintf_filtered (stream
, "}");
129 /* Array of unspecified length: treat like pointer to first elt. */
131 goto print_unpacked_pointer
;
134 if (options
->format
&& options
->format
!= 's')
136 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
140 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
142 /* Print the unmangled name if desired. */
143 /* Print vtable entry - we only get here if we ARE using
144 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
145 /* Extract the address, assume that it is unsigned. */
146 print_address_demangle (gdbarch
,
147 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 (gdbarch
, addr
, stream
, demangle
);
161 /* Return value is irrelevant except for string pointers. */
165 if (options
->addressprint
&& options
->format
!= 's')
167 fputs_filtered (paddress (gdbarch
, 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 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
176 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
177 && (options
->format
== 0 || options
->format
== 's')
180 /* no wide string yet */
181 i
= val_print_string (elttype
, addr
, -1, stream
, options
);
183 /* also for pointers to pascal strings */
184 /* Note: this is Free Pascal specific:
185 as GDB does not recognize stabs pascal strings
186 Pascal strings are mapped to records
187 with lowercase names PM */
188 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
189 &string_pos
, &char_type
, NULL
)
192 ULONGEST string_length
;
194 buffer
= xmalloc (length_size
);
195 read_memory (addr
+ length_pos
, buffer
, length_size
);
196 string_length
= extract_unsigned_integer (buffer
, length_size
);
198 i
= val_print_string (char_type
,addr
+ string_pos
, string_length
, stream
, options
);
200 else if (pascal_object_is_vtbl_member (type
))
202 /* print vtbl's nicely */
203 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
205 struct minimal_symbol
*msymbol
=
206 lookup_minimal_symbol_by_pc (vt_address
);
207 if ((msymbol
!= NULL
)
208 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
210 fputs_filtered (" <", stream
);
211 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
212 fputs_filtered (">", stream
);
214 if (vt_address
&& options
->vtblprint
)
216 struct value
*vt_val
;
217 struct symbol
*wsym
= (struct symbol
*) NULL
;
219 struct block
*block
= (struct block
*) NULL
;
223 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
224 VAR_DOMAIN
, &is_this_fld
);
228 wtype
= SYMBOL_TYPE (wsym
);
232 wtype
= TYPE_TARGET_TYPE (type
);
234 vt_val
= value_at (wtype
, vt_address
);
235 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
239 fprintf_filtered (stream
, "\n");
240 print_spaces_filtered (2 + 2 * recurse
, stream
);
245 /* Return number of characters printed, including the terminating
246 '\0' if we reached the end. val_print_string takes care including
247 the terminating '\0' if necessary. */
253 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
254 if (options
->addressprint
)
257 = extract_typed_address (valaddr
+ embedded_offset
, type
);
258 fprintf_filtered (stream
, "@");
259 fputs_filtered (paddress (gdbarch
, addr
), stream
);
260 if (options
->deref_ref
)
261 fputs_filtered (": ", stream
);
263 /* De-reference the reference. */
264 if (options
->deref_ref
)
266 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
268 struct value
*deref_val
=
270 (TYPE_TARGET_TYPE (type
),
271 unpack_pointer (type
, valaddr
+ embedded_offset
));
272 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
276 fputs_filtered ("???", stream
);
280 case TYPE_CODE_UNION
:
281 if (recurse
&& !options
->unionprint
)
283 fprintf_filtered (stream
, "{...}");
287 case TYPE_CODE_STRUCT
:
288 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
290 /* Print the unmangled name if desired. */
291 /* Print vtable entry - we only get here if NOT using
292 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
293 /* Extract the address, assume that it is unsigned. */
294 print_address_demangle
296 extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
297 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
302 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
303 &string_pos
, &char_type
, NULL
))
305 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
306 LA_PRINT_STRING (stream
, char_type
, valaddr
+ embedded_offset
+ string_pos
, len
, 0, options
);
309 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
310 recurse
, options
, NULL
, 0);
317 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
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
,
346 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
352 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
356 /* FIXME, we should consider, at least for ANSI C language, eliminating
357 the distinction made between FUNCs and POINTERs to FUNCs. */
358 fprintf_filtered (stream
, "{");
359 type_print (type
, "", stream
, -1);
360 fprintf_filtered (stream
, "} ");
361 /* Try to print what function it points to, and its address. */
362 print_address_demangle (gdbarch
, address
, stream
, demangle
);
366 if (options
->format
|| options
->output_format
)
368 struct value_print_options opts
= *options
;
369 opts
.format
= (options
->format
? options
->format
370 : options
->output_format
);
371 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
376 val
= unpack_long (type
, valaddr
+ embedded_offset
);
378 fputs_filtered ("false", stream
);
380 fputs_filtered ("true", stream
);
383 fputs_filtered ("true (", stream
);
384 fprintf_filtered (stream
, "%ld)", (long int) val
);
389 case TYPE_CODE_RANGE
:
390 /* FIXME: create_range_type does not set the unsigned bit in a
391 range type (I think it probably should copy it from the target
392 type), so we won't print values which are too large to
393 fit in a signed integer correctly. */
394 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
395 print with the target type, though, because the size of our type
396 and the target type might differ). */
400 if (options
->format
|| options
->output_format
)
402 struct value_print_options opts
= *options
;
403 opts
.format
= (options
->format
? options
->format
404 : options
->output_format
);
405 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
410 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
415 if (options
->format
|| options
->output_format
)
417 struct value_print_options opts
= *options
;
418 opts
.format
= (options
->format
? options
->format
419 : options
->output_format
);
420 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
425 val
= unpack_long (type
, valaddr
+ embedded_offset
);
426 if (TYPE_UNSIGNED (type
))
427 fprintf_filtered (stream
, "%u", (unsigned int) val
);
429 fprintf_filtered (stream
, "%d", (int) val
);
430 fputs_filtered (" ", stream
);
431 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
438 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
443 print_floating (valaddr
+ embedded_offset
, type
, stream
);
447 case TYPE_CODE_BITSTRING
:
449 elttype
= TYPE_INDEX_TYPE (type
);
450 CHECK_TYPEDEF (elttype
);
451 if (TYPE_STUB (elttype
))
453 fprintf_filtered (stream
, "<incomplete type>");
459 struct type
*range
= elttype
;
460 LONGEST low_bound
, high_bound
;
462 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
466 fputs_filtered ("B'", stream
);
468 fputs_filtered ("[", stream
);
470 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
474 fputs_filtered ("<error value>", stream
);
478 for (i
= low_bound
; i
<= high_bound
; i
++)
480 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
484 goto maybe_bad_bstring
;
487 fprintf_filtered (stream
, "%d", element
);
491 fputs_filtered (", ", stream
);
492 print_type_scalar (range
, i
, stream
);
495 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
498 fputs_filtered ("..", stream
);
499 while (i
+ 1 <= high_bound
500 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
502 print_type_scalar (range
, j
, stream
);
508 fputs_filtered ("'", stream
);
510 fputs_filtered ("]", stream
);
515 fprintf_filtered (stream
, "void");
518 case TYPE_CODE_ERROR
:
519 fprintf_filtered (stream
, "<error type>");
522 case TYPE_CODE_UNDEF
:
523 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
524 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
525 and no complete type for struct foo in that file. */
526 fprintf_filtered (stream
, "<incomplete type>");
530 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
537 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
538 const struct value_print_options
*options
)
540 struct type
*type
= value_type (val
);
542 /* If it is a pointer, indicate what it points to.
544 Print type also if it is a reference.
546 Object pascal: if it is a member pointer, we will take care
547 of that when we print it. */
548 if (TYPE_CODE (type
) == TYPE_CODE_PTR
549 || TYPE_CODE (type
) == TYPE_CODE_REF
)
551 /* Hack: remove (char *) for char strings. Their
552 type is indicated by the quoted string anyway. */
553 if (TYPE_CODE (type
) == TYPE_CODE_PTR
554 && TYPE_NAME (type
) == NULL
555 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
556 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
562 fprintf_filtered (stream
, "(");
563 type_print (type
, "", stream
, -1);
564 fprintf_filtered (stream
, ") ");
567 return common_val_print (val
, stream
, 0, options
, current_language
);
572 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
573 struct cmd_list_element
*c
, const char *value
)
575 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
579 static struct obstack dont_print_vb_obstack
;
580 static struct obstack dont_print_statmem_obstack
;
582 static void pascal_object_print_static_field (struct value
*,
583 struct ui_file
*, int,
584 const struct value_print_options
*);
586 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
587 CORE_ADDR
, struct ui_file
*, int,
588 const struct value_print_options
*,
591 /* It was changed to this after 2.4.5. */
592 const char pascal_vtbl_ptr_name
[] =
593 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
595 /* Return truth value for assertion that TYPE is of the type
596 "pointer to virtual function". */
599 pascal_object_is_vtbl_ptr_type (struct type
*type
)
601 char *typename
= type_name_no_tag (type
);
603 return (typename
!= NULL
604 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
607 /* Return truth value for the assertion that TYPE is of the type
608 "pointer to virtual function table". */
611 pascal_object_is_vtbl_member (struct type
*type
)
613 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
615 type
= TYPE_TARGET_TYPE (type
);
616 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
618 type
= TYPE_TARGET_TYPE (type
);
619 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
620 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
622 /* Virtual functions tables are full of pointers
623 to virtual functions. */
624 return pascal_object_is_vtbl_ptr_type (type
);
631 /* Mutually recursive subroutines of pascal_object_print_value and
632 c_val_print to print out a structure's fields:
633 pascal_object_print_value_fields and pascal_object_print_value.
635 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
636 same meanings as in pascal_object_print_value and c_val_print.
638 DONT_PRINT is an array of baseclass types that we
639 should not print, or zero if called from top level. */
642 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
643 CORE_ADDR address
, struct ui_file
*stream
,
645 const struct value_print_options
*options
,
646 struct type
**dont_print_vb
,
647 int dont_print_statmem
)
649 int i
, len
, n_baseclasses
;
650 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
652 CHECK_TYPEDEF (type
);
654 fprintf_filtered (stream
, "{");
655 len
= TYPE_NFIELDS (type
);
656 n_baseclasses
= TYPE_N_BASECLASSES (type
);
658 /* Print out baseclasses such that we don't print
659 duplicates of virtual baseclasses. */
660 if (n_baseclasses
> 0)
661 pascal_object_print_value (type
, valaddr
, address
, stream
,
662 recurse
+ 1, options
, dont_print_vb
);
664 if (!len
&& n_baseclasses
== 1)
665 fprintf_filtered (stream
, "<No data fields>");
668 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
671 if (dont_print_statmem
== 0)
673 /* If we're at top level, carve out a completely fresh
674 chunk of the obstack and use that until this particular
675 invocation returns. */
676 obstack_finish (&dont_print_statmem_obstack
);
679 for (i
= n_baseclasses
; i
< len
; i
++)
681 /* If requested, skip printing of static fields. */
682 if (!options
->pascal_static_field_print
683 && field_is_static (&TYPE_FIELD (type
, i
)))
686 fprintf_filtered (stream
, ", ");
687 else if (n_baseclasses
> 0)
691 fprintf_filtered (stream
, "\n");
692 print_spaces_filtered (2 + 2 * recurse
, stream
);
693 fputs_filtered ("members of ", stream
);
694 fputs_filtered (type_name_no_tag (type
), stream
);
695 fputs_filtered (": ", stream
);
702 fprintf_filtered (stream
, "\n");
703 print_spaces_filtered (2 + 2 * recurse
, stream
);
707 wrap_here (n_spaces (2 + 2 * recurse
));
709 if (options
->inspect_it
)
711 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
712 fputs_filtered ("\"( ptr \"", stream
);
714 fputs_filtered ("\"( nodef \"", stream
);
715 if (field_is_static (&TYPE_FIELD (type
, i
)))
716 fputs_filtered ("static ", stream
);
717 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
719 DMGL_PARAMS
| DMGL_ANSI
);
720 fputs_filtered ("\" \"", stream
);
721 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
723 DMGL_PARAMS
| DMGL_ANSI
);
724 fputs_filtered ("\") \"", stream
);
728 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
730 if (field_is_static (&TYPE_FIELD (type
, i
)))
731 fputs_filtered ("static ", stream
);
732 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
734 DMGL_PARAMS
| DMGL_ANSI
);
735 annotate_field_name_end ();
736 fputs_filtered (" = ", stream
);
737 annotate_field_value ();
740 if (!field_is_static (&TYPE_FIELD (type
, i
))
741 && TYPE_FIELD_PACKED (type
, i
))
745 /* Bitfields require special handling, especially due to byte
747 if (TYPE_FIELD_IGNORE (type
, i
))
749 fputs_filtered ("<optimized out or zero length>", stream
);
753 struct value_print_options opts
= *options
;
754 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
755 unpack_field_as_long (type
, valaddr
, i
));
758 common_val_print (v
, stream
, recurse
+ 1, &opts
,
764 if (TYPE_FIELD_IGNORE (type
, i
))
766 fputs_filtered ("<optimized out or zero length>", stream
);
768 else if (field_is_static (&TYPE_FIELD (type
, i
)))
770 /* struct value *v = value_static_field (type, i); v4.17 specific */
772 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
773 unpack_field_as_long (type
, valaddr
, i
));
776 fputs_filtered ("<optimized out>", stream
);
778 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
783 struct value_print_options opts
= *options
;
785 /* val_print (TYPE_FIELD_TYPE (type, i),
786 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
787 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
788 stream, format, 0, recurse + 1, pretty); */
789 val_print (TYPE_FIELD_TYPE (type
, i
),
790 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
791 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
792 stream
, recurse
+ 1, &opts
,
796 annotate_field_end ();
799 if (dont_print_statmem
== 0)
801 /* Free the space used to deal with the printing
802 of the members from top level. */
803 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
804 dont_print_statmem_obstack
= tmp_obstack
;
809 fprintf_filtered (stream
, "\n");
810 print_spaces_filtered (2 * recurse
, stream
);
813 fprintf_filtered (stream
, "}");
816 /* Special val_print routine to avoid printing multiple copies of virtual
820 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
821 CORE_ADDR address
, struct ui_file
*stream
,
823 const struct value_print_options
*options
,
824 struct type
**dont_print_vb
)
826 struct type
**last_dont_print
827 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
828 struct obstack tmp_obstack
= dont_print_vb_obstack
;
829 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
831 if (dont_print_vb
== 0)
833 /* If we're at top level, carve out a completely fresh
834 chunk of the obstack and use that until this particular
835 invocation returns. */
836 /* Bump up the high-water mark. Now alpha is omega. */
837 obstack_finish (&dont_print_vb_obstack
);
840 for (i
= 0; i
< n_baseclasses
; i
++)
843 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
844 char *basename
= type_name_no_tag (baseclass
);
845 const gdb_byte
*base_valaddr
;
847 if (BASETYPE_VIA_VIRTUAL (type
, i
))
849 struct type
**first_dont_print
850 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
852 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
856 if (baseclass
== first_dont_print
[j
])
859 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
862 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
866 fprintf_filtered (stream
, "\n");
867 print_spaces_filtered (2 * recurse
, stream
);
869 fputs_filtered ("<", stream
);
870 /* Not sure what the best notation is in the case where there is no
873 fputs_filtered (basename
? basename
: "", stream
);
874 fputs_filtered ("> = ", stream
);
876 /* The virtual base class pointer might have been clobbered by the
877 user program. Make sure that it still points to a valid memory
880 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
882 /* FIXME (alloc): not safe is baseclass is really really big. */
883 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
885 if (target_read_memory (address
+ boffset
, buf
,
886 TYPE_LENGTH (baseclass
)) != 0)
890 base_valaddr
= valaddr
+ boffset
;
893 fprintf_filtered (stream
, "<invalid address>");
895 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
896 stream
, recurse
, options
,
897 (struct type
**) obstack_base (&dont_print_vb_obstack
),
899 fputs_filtered (", ", stream
);
905 if (dont_print_vb
== 0)
907 /* Free the space used to deal with the printing
908 of this type from top level. */
909 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
910 /* Reset watermark so that we can continue protecting
911 ourselves from whatever we were protecting ourselves. */
912 dont_print_vb_obstack
= tmp_obstack
;
916 /* Print value of a static member.
917 To avoid infinite recursion when printing a class that contains
918 a static instance of the class, we keep the addresses of all printed
919 static member classes in an obstack and refuse to print them more
922 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
923 have the same meanings as in c_val_print. */
926 pascal_object_print_static_field (struct value
*val
,
927 struct ui_file
*stream
,
929 const struct value_print_options
*options
)
931 struct type
*type
= value_type (val
);
932 struct value_print_options opts
;
934 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
936 CORE_ADDR
*first_dont_print
, addr
;
940 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
941 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
946 if (value_address (val
) == first_dont_print
[i
])
948 fputs_filtered ("<same as static member of an already seen type>",
954 addr
= value_address (val
);
955 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
958 CHECK_TYPEDEF (type
);
959 pascal_object_print_value_fields (type
, value_contents (val
), addr
,
960 stream
, recurse
, options
, NULL
, 1);
966 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
969 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
972 _initialize_pascal_valprint (void)
974 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
975 &user_print_options
.pascal_static_field_print
, _("\
976 Set printing of pascal static members."), _("\
977 Show printing of pascal static members."), NULL
,
979 show_pascal_static_field_print
,
980 &setprintlist
, &showprintlist
);