1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010
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 enum bfd_endian byte_order
= gdbarch_byte_order (gdbarch
);
61 unsigned int i
= 0; /* Number of characters printed */
65 int length_pos
, length_size
, string_pos
;
66 struct type
*char_type
;
71 switch (TYPE_CODE (type
))
74 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
76 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
77 eltlen
= TYPE_LENGTH (elttype
);
78 len
= TYPE_LENGTH (type
) / eltlen
;
79 if (options
->prettyprint_arrays
)
81 print_spaces_filtered (2 + 2 * recurse
, stream
);
83 /* For an array of chars, print with string syntax. */
84 if ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
85 && ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
86 || ((current_language
->la_language
== language_pascal
)
87 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
88 && (options
->format
== 0 || options
->format
== 's'))
90 /* If requested, look for the first null char and only print
92 if (options
->stop_print_at_null
)
94 unsigned int temp_len
;
96 /* Look for a NULL char. */
98 extract_unsigned_integer (valaddr
+ embedded_offset
+
99 temp_len
* eltlen
, eltlen
,
101 && temp_len
< len
&& temp_len
< options
->print_max
;
106 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
107 valaddr
+ embedded_offset
, len
, NULL
, 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 recurse
, options
, i
);
127 fprintf_filtered (stream
, "}");
131 /* Array of unspecified length: treat like pointer to first elt. */
133 goto print_unpacked_pointer
;
136 if (options
->format
&& options
->format
!= 's')
138 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
142 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
144 /* Print the unmangled name if desired. */
145 /* Print vtable entry - we only get here if we ARE using
146 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
147 /* Extract the address, assume that it is unsigned. */
148 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
149 TYPE_LENGTH (type
), byte_order
);
150 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
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 (gdbarch
, addr
, stream
, demangle
);
163 /* Return value is irrelevant except for string pointers. */
167 if (options
->addressprint
&& options
->format
!= 's')
169 fputs_filtered (paddress (gdbarch
, addr
), 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 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
177 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
178 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
179 && (options
->format
== 0 || options
->format
== 's')
182 /* no wide string yet */
183 i
= val_print_string (elttype
, addr
, -1, stream
, options
);
185 /* also for pointers to pascal strings */
186 /* Note: this is Free Pascal specific:
187 as GDB does not recognize stabs pascal strings
188 Pascal strings are mapped to records
189 with lowercase names PM */
190 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
191 &string_pos
, &char_type
, NULL
)
194 ULONGEST string_length
;
196 buffer
= xmalloc (length_size
);
197 read_memory (addr
+ length_pos
, buffer
, length_size
);
198 string_length
= extract_unsigned_integer (buffer
, length_size
,
201 i
= val_print_string (char_type
,addr
+ string_pos
, string_length
, stream
, options
);
203 else if (pascal_object_is_vtbl_member (type
))
205 /* print vtbl's nicely */
206 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
208 struct minimal_symbol
*msymbol
=
209 lookup_minimal_symbol_by_pc (vt_address
);
210 if ((msymbol
!= NULL
)
211 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
213 fputs_filtered (" <", stream
);
214 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
215 fputs_filtered (">", stream
);
217 if (vt_address
&& options
->vtblprint
)
219 struct value
*vt_val
;
220 struct symbol
*wsym
= (struct symbol
*) NULL
;
222 struct block
*block
= (struct block
*) NULL
;
226 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
227 VAR_DOMAIN
, &is_this_fld
);
231 wtype
= SYMBOL_TYPE (wsym
);
235 wtype
= TYPE_TARGET_TYPE (type
);
237 vt_val
= value_at (wtype
, vt_address
);
238 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
242 fprintf_filtered (stream
, "\n");
243 print_spaces_filtered (2 + 2 * recurse
, stream
);
248 /* Return number of characters printed, including the terminating
249 '\0' if we reached the end. val_print_string takes care including
250 the terminating '\0' if necessary. */
256 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
257 if (options
->addressprint
)
260 = extract_typed_address (valaddr
+ embedded_offset
, type
);
261 fprintf_filtered (stream
, "@");
262 fputs_filtered (paddress (gdbarch
, addr
), stream
);
263 if (options
->deref_ref
)
264 fputs_filtered (": ", stream
);
266 /* De-reference the reference. */
267 if (options
->deref_ref
)
269 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
271 struct value
*deref_val
=
273 (TYPE_TARGET_TYPE (type
),
274 unpack_pointer (type
, valaddr
+ embedded_offset
));
275 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
279 fputs_filtered ("???", stream
);
283 case TYPE_CODE_UNION
:
284 if (recurse
&& !options
->unionprint
)
286 fprintf_filtered (stream
, "{...}");
290 case TYPE_CODE_STRUCT
:
291 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
293 /* Print the unmangled name if desired. */
294 /* Print vtable entry - we only get here if NOT using
295 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
296 /* Extract the address, assume that it is unsigned. */
297 print_address_demangle
299 extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
300 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
)), byte_order
),
305 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
306 &string_pos
, &char_type
, NULL
))
308 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
, byte_order
);
309 LA_PRINT_STRING (stream
, char_type
,
310 valaddr
+ embedded_offset
+ string_pos
,
311 len
, NULL
, 0, options
);
314 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
315 recurse
, options
, NULL
, 0);
322 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
326 len
= TYPE_NFIELDS (type
);
327 val
= unpack_long (type
, valaddr
+ embedded_offset
);
328 for (i
= 0; i
< len
; i
++)
331 if (val
== TYPE_FIELD_BITPOS (type
, i
))
338 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
342 print_longest (stream
, 'd', 0, val
);
346 case TYPE_CODE_FLAGS
:
348 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
351 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
357 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
361 /* FIXME, we should consider, at least for ANSI C language, eliminating
362 the distinction made between FUNCs and POINTERs to FUNCs. */
363 fprintf_filtered (stream
, "{");
364 type_print (type
, "", stream
, -1);
365 fprintf_filtered (stream
, "} ");
366 /* Try to print what function it points to, and its address. */
367 print_address_demangle (gdbarch
, address
, stream
, demangle
);
371 if (options
->format
|| options
->output_format
)
373 struct value_print_options opts
= *options
;
374 opts
.format
= (options
->format
? options
->format
375 : options
->output_format
);
376 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
381 val
= unpack_long (type
, valaddr
+ embedded_offset
);
383 fputs_filtered ("false", stream
);
385 fputs_filtered ("true", stream
);
388 fputs_filtered ("true (", stream
);
389 fprintf_filtered (stream
, "%ld)", (long int) val
);
394 case TYPE_CODE_RANGE
:
395 /* FIXME: create_range_type does not set the unsigned bit in a
396 range type (I think it probably should copy it from the target
397 type), so we won't print values which are too large to
398 fit in a signed integer correctly. */
399 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
400 print with the target type, though, because the size of our type
401 and the target type might differ). */
405 if (options
->format
|| options
->output_format
)
407 struct value_print_options opts
= *options
;
408 opts
.format
= (options
->format
? options
->format
409 : options
->output_format
);
410 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
415 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
420 if (options
->format
|| options
->output_format
)
422 struct value_print_options opts
= *options
;
423 opts
.format
= (options
->format
? options
->format
424 : options
->output_format
);
425 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
430 val
= unpack_long (type
, valaddr
+ embedded_offset
);
431 if (TYPE_UNSIGNED (type
))
432 fprintf_filtered (stream
, "%u", (unsigned int) val
);
434 fprintf_filtered (stream
, "%d", (int) val
);
435 fputs_filtered (" ", stream
);
436 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
443 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
448 print_floating (valaddr
+ embedded_offset
, type
, stream
);
452 case TYPE_CODE_BITSTRING
:
454 elttype
= TYPE_INDEX_TYPE (type
);
455 CHECK_TYPEDEF (elttype
);
456 if (TYPE_STUB (elttype
))
458 fprintf_filtered (stream
, "<incomplete type>");
464 struct type
*range
= elttype
;
465 LONGEST low_bound
, high_bound
;
467 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
471 fputs_filtered ("B'", stream
);
473 fputs_filtered ("[", stream
);
475 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
479 fputs_filtered ("<error value>", stream
);
483 for (i
= low_bound
; i
<= high_bound
; i
++)
485 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
489 goto maybe_bad_bstring
;
492 fprintf_filtered (stream
, "%d", element
);
496 fputs_filtered (", ", stream
);
497 print_type_scalar (range
, i
, stream
);
500 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
503 fputs_filtered ("..", stream
);
504 while (i
+ 1 <= high_bound
505 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
507 print_type_scalar (range
, j
, stream
);
513 fputs_filtered ("'", stream
);
515 fputs_filtered ("]", stream
);
520 fprintf_filtered (stream
, "void");
523 case TYPE_CODE_ERROR
:
524 fprintf_filtered (stream
, "<error type>");
527 case TYPE_CODE_UNDEF
:
528 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
529 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
530 and no complete type for struct foo in that file. */
531 fprintf_filtered (stream
, "<incomplete type>");
535 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
542 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
543 const struct value_print_options
*options
)
545 struct type
*type
= value_type (val
);
547 /* If it is a pointer, indicate what it points to.
549 Print type also if it is a reference.
551 Object pascal: if it is a member pointer, we will take care
552 of that when we print it. */
553 if (TYPE_CODE (type
) == TYPE_CODE_PTR
554 || TYPE_CODE (type
) == TYPE_CODE_REF
)
556 /* Hack: remove (char *) for char strings. Their
557 type is indicated by the quoted string anyway. */
558 if (TYPE_CODE (type
) == TYPE_CODE_PTR
559 && TYPE_NAME (type
) == NULL
560 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
561 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
567 fprintf_filtered (stream
, "(");
568 type_print (type
, "", stream
, -1);
569 fprintf_filtered (stream
, ") ");
572 return common_val_print (val
, stream
, 0, options
, current_language
);
577 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
578 struct cmd_list_element
*c
, const char *value
)
580 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
584 static struct obstack dont_print_vb_obstack
;
585 static struct obstack dont_print_statmem_obstack
;
587 static void pascal_object_print_static_field (struct value
*,
588 struct ui_file
*, int,
589 const struct value_print_options
*);
591 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
592 CORE_ADDR
, struct ui_file
*, int,
593 const struct value_print_options
*,
596 /* It was changed to this after 2.4.5. */
597 const char pascal_vtbl_ptr_name
[] =
598 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
600 /* Return truth value for assertion that TYPE is of the type
601 "pointer to virtual function". */
604 pascal_object_is_vtbl_ptr_type (struct type
*type
)
606 char *typename
= type_name_no_tag (type
);
608 return (typename
!= NULL
609 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
612 /* Return truth value for the assertion that TYPE is of the type
613 "pointer to virtual function table". */
616 pascal_object_is_vtbl_member (struct type
*type
)
618 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
620 type
= TYPE_TARGET_TYPE (type
);
621 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
623 type
= TYPE_TARGET_TYPE (type
);
624 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
625 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
627 /* Virtual functions tables are full of pointers
628 to virtual functions. */
629 return pascal_object_is_vtbl_ptr_type (type
);
636 /* Mutually recursive subroutines of pascal_object_print_value and
637 c_val_print to print out a structure's fields:
638 pascal_object_print_value_fields and pascal_object_print_value.
640 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
641 same meanings as in pascal_object_print_value and c_val_print.
643 DONT_PRINT is an array of baseclass types that we
644 should not print, or zero if called from top level. */
647 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
648 CORE_ADDR address
, struct ui_file
*stream
,
650 const struct value_print_options
*options
,
651 struct type
**dont_print_vb
,
652 int dont_print_statmem
)
654 int i
, len
, n_baseclasses
;
655 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
657 CHECK_TYPEDEF (type
);
659 fprintf_filtered (stream
, "{");
660 len
= TYPE_NFIELDS (type
);
661 n_baseclasses
= TYPE_N_BASECLASSES (type
);
663 /* Print out baseclasses such that we don't print
664 duplicates of virtual baseclasses. */
665 if (n_baseclasses
> 0)
666 pascal_object_print_value (type
, valaddr
, address
, stream
,
667 recurse
+ 1, options
, dont_print_vb
);
669 if (!len
&& n_baseclasses
== 1)
670 fprintf_filtered (stream
, "<No data fields>");
673 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
676 if (dont_print_statmem
== 0)
678 /* If we're at top level, carve out a completely fresh
679 chunk of the obstack and use that until this particular
680 invocation returns. */
681 obstack_finish (&dont_print_statmem_obstack
);
684 for (i
= n_baseclasses
; i
< len
; i
++)
686 /* If requested, skip printing of static fields. */
687 if (!options
->pascal_static_field_print
688 && field_is_static (&TYPE_FIELD (type
, i
)))
691 fprintf_filtered (stream
, ", ");
692 else if (n_baseclasses
> 0)
696 fprintf_filtered (stream
, "\n");
697 print_spaces_filtered (2 + 2 * recurse
, stream
);
698 fputs_filtered ("members of ", stream
);
699 fputs_filtered (type_name_no_tag (type
), stream
);
700 fputs_filtered (": ", stream
);
707 fprintf_filtered (stream
, "\n");
708 print_spaces_filtered (2 + 2 * recurse
, stream
);
712 wrap_here (n_spaces (2 + 2 * recurse
));
714 if (options
->inspect_it
)
716 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
717 fputs_filtered ("\"( ptr \"", stream
);
719 fputs_filtered ("\"( nodef \"", stream
);
720 if (field_is_static (&TYPE_FIELD (type
, i
)))
721 fputs_filtered ("static ", stream
);
722 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
724 DMGL_PARAMS
| DMGL_ANSI
);
725 fputs_filtered ("\" \"", stream
);
726 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
728 DMGL_PARAMS
| DMGL_ANSI
);
729 fputs_filtered ("\") \"", stream
);
733 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
735 if (field_is_static (&TYPE_FIELD (type
, i
)))
736 fputs_filtered ("static ", stream
);
737 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
739 DMGL_PARAMS
| DMGL_ANSI
);
740 annotate_field_name_end ();
741 fputs_filtered (" = ", stream
);
742 annotate_field_value ();
745 if (!field_is_static (&TYPE_FIELD (type
, i
))
746 && TYPE_FIELD_PACKED (type
, i
))
750 /* Bitfields require special handling, especially due to byte
752 if (TYPE_FIELD_IGNORE (type
, i
))
754 fputs_filtered ("<optimized out or zero length>", stream
);
758 struct value_print_options opts
= *options
;
759 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
760 unpack_field_as_long (type
, valaddr
, i
));
763 common_val_print (v
, stream
, recurse
+ 1, &opts
,
769 if (TYPE_FIELD_IGNORE (type
, i
))
771 fputs_filtered ("<optimized out or zero length>", stream
);
773 else if (field_is_static (&TYPE_FIELD (type
, i
)))
775 /* struct value *v = value_static_field (type, i); v4.17 specific */
777 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
778 unpack_field_as_long (type
, valaddr
, i
));
781 fputs_filtered ("<optimized out>", stream
);
783 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
788 struct value_print_options opts
= *options
;
790 /* val_print (TYPE_FIELD_TYPE (type, i),
791 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
792 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
793 stream, format, 0, recurse + 1, pretty); */
794 val_print (TYPE_FIELD_TYPE (type
, i
),
795 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
796 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
797 stream
, recurse
+ 1, &opts
,
801 annotate_field_end ();
804 if (dont_print_statmem
== 0)
806 /* Free the space used to deal with the printing
807 of the members from top level. */
808 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
809 dont_print_statmem_obstack
= tmp_obstack
;
814 fprintf_filtered (stream
, "\n");
815 print_spaces_filtered (2 * recurse
, stream
);
818 fprintf_filtered (stream
, "}");
821 /* Special val_print routine to avoid printing multiple copies of virtual
825 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
826 CORE_ADDR address
, struct ui_file
*stream
,
828 const struct value_print_options
*options
,
829 struct type
**dont_print_vb
)
831 struct type
**last_dont_print
832 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
833 struct obstack tmp_obstack
= dont_print_vb_obstack
;
834 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
836 if (dont_print_vb
== 0)
838 /* If we're at top level, carve out a completely fresh
839 chunk of the obstack and use that until this particular
840 invocation returns. */
841 /* Bump up the high-water mark. Now alpha is omega. */
842 obstack_finish (&dont_print_vb_obstack
);
845 for (i
= 0; i
< n_baseclasses
; i
++)
848 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
849 char *basename
= type_name_no_tag (baseclass
);
850 const gdb_byte
*base_valaddr
;
852 if (BASETYPE_VIA_VIRTUAL (type
, i
))
854 struct type
**first_dont_print
855 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
857 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
861 if (baseclass
== first_dont_print
[j
])
864 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
867 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
871 fprintf_filtered (stream
, "\n");
872 print_spaces_filtered (2 * recurse
, stream
);
874 fputs_filtered ("<", stream
);
875 /* Not sure what the best notation is in the case where there is no
878 fputs_filtered (basename
? basename
: "", stream
);
879 fputs_filtered ("> = ", stream
);
881 /* The virtual base class pointer might have been clobbered by the
882 user program. Make sure that it still points to a valid memory
885 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
887 /* FIXME (alloc): not safe is baseclass is really really big. */
888 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
890 if (target_read_memory (address
+ boffset
, buf
,
891 TYPE_LENGTH (baseclass
)) != 0)
895 base_valaddr
= valaddr
+ boffset
;
898 fprintf_filtered (stream
, "<invalid address>");
900 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
901 stream
, recurse
, options
,
902 (struct type
**) obstack_base (&dont_print_vb_obstack
),
904 fputs_filtered (", ", stream
);
910 if (dont_print_vb
== 0)
912 /* Free the space used to deal with the printing
913 of this type from top level. */
914 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
915 /* Reset watermark so that we can continue protecting
916 ourselves from whatever we were protecting ourselves. */
917 dont_print_vb_obstack
= tmp_obstack
;
921 /* Print value of a static member.
922 To avoid infinite recursion when printing a class that contains
923 a static instance of the class, we keep the addresses of all printed
924 static member classes in an obstack and refuse to print them more
927 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
928 have the same meanings as in c_val_print. */
931 pascal_object_print_static_field (struct value
*val
,
932 struct ui_file
*stream
,
934 const struct value_print_options
*options
)
936 struct type
*type
= value_type (val
);
937 struct value_print_options opts
;
939 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
941 CORE_ADDR
*first_dont_print
, addr
;
945 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
946 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
951 if (value_address (val
) == first_dont_print
[i
])
953 fputs_filtered ("<same as static member of an already seen type>",
959 addr
= value_address (val
);
960 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
963 CHECK_TYPEDEF (type
);
964 pascal_object_print_value_fields (type
, value_contents (val
), addr
,
965 stream
, recurse
, options
, NULL
, 1);
971 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
974 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
977 _initialize_pascal_valprint (void)
979 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
980 &user_print_options
.pascal_static_field_print
, _("\
981 Set printing of pascal static members."), _("\
982 Show printing of pascal static members."), NULL
,
984 show_pascal_static_field_print
,
985 &setprintlist
, &showprintlist
);