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
*original_value
,
58 const struct value_print_options
*options
)
60 struct gdbarch
*gdbarch
= get_type_arch (type
);
61 enum bfd_endian byte_order
= gdbarch_byte_order (gdbarch
);
62 unsigned int i
= 0; /* Number of characters printed */
64 LONGEST low_bound
, high_bound
;
67 int length_pos
, length_size
, string_pos
;
68 struct type
*char_type
;
73 switch (TYPE_CODE (type
))
76 if (get_array_bounds (type
, &low_bound
, &high_bound
))
78 len
= high_bound
- low_bound
+ 1;
79 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
80 eltlen
= TYPE_LENGTH (elttype
);
81 if (options
->prettyprint_arrays
)
83 print_spaces_filtered (2 + 2 * recurse
, stream
);
85 /* If 's' format is used, try to print out as string.
86 If no format is given, print as string if element type
87 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
88 if (options
->format
== 's'
89 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
90 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
91 && options
->format
== 0))
93 /* If requested, look for the first null char and only print
95 if (options
->stop_print_at_null
)
97 unsigned int temp_len
;
99 /* Look for a NULL char. */
101 extract_unsigned_integer (valaddr
+ embedded_offset
+
102 temp_len
* eltlen
, eltlen
,
104 && temp_len
< len
&& temp_len
< options
->print_max
;
109 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
110 valaddr
+ embedded_offset
, len
, NULL
, 0,
116 fprintf_filtered (stream
, "{");
117 /* If this is a virtual function table, print the 0th
118 entry specially, and the rest of the members normally. */
119 if (pascal_object_is_vtbl_ptr_type (elttype
))
122 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
128 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
129 recurse
, original_value
, options
, i
);
130 fprintf_filtered (stream
, "}");
134 /* Array of unspecified length: treat like pointer to first elt. */
136 goto print_unpacked_pointer
;
139 if (options
->format
&& options
->format
!= 's')
141 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
145 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
147 /* Print the unmangled name if desired. */
148 /* Print vtable entry - we only get here if we ARE using
149 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
150 /* Extract the address, assume that it is unsigned. */
151 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
152 TYPE_LENGTH (type
), byte_order
);
153 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
156 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
158 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
159 print_unpacked_pointer
:
160 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
162 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
164 /* Try to print what function it points to. */
165 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
166 /* Return value is irrelevant except for string pointers. */
170 if (options
->addressprint
&& options
->format
!= 's')
172 fputs_filtered (paddress (gdbarch
, addr
), stream
);
175 /* For a pointer to char or unsigned char, also print the string
176 pointed to, unless pointer is null. */
177 if (((TYPE_LENGTH (elttype
) == 1
178 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
179 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
180 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
181 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
182 && (options
->format
== 0 || options
->format
== 's')
185 /* no wide string yet */
186 i
= val_print_string (elttype
, addr
, -1, stream
, options
);
188 /* also for pointers to pascal strings */
189 /* Note: this is Free Pascal specific:
190 as GDB does not recognize stabs pascal strings
191 Pascal strings are mapped to records
192 with lowercase names PM */
193 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
194 &string_pos
, &char_type
, NULL
)
197 ULONGEST string_length
;
200 buffer
= xmalloc (length_size
);
201 read_memory (addr
+ length_pos
, buffer
, length_size
);
202 string_length
= extract_unsigned_integer (buffer
, length_size
,
205 i
= val_print_string (char_type
,addr
+ string_pos
, string_length
, stream
, options
);
207 else if (pascal_object_is_vtbl_member (type
))
209 /* print vtbl's nicely */
210 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
211 struct minimal_symbol
*msymbol
=
212 lookup_minimal_symbol_by_pc (vt_address
);
214 if ((msymbol
!= NULL
)
215 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
217 fputs_filtered (" <", stream
);
218 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
219 fputs_filtered (">", stream
);
221 if (vt_address
&& options
->vtblprint
)
223 struct value
*vt_val
;
224 struct symbol
*wsym
= (struct symbol
*) NULL
;
226 struct block
*block
= (struct block
*) NULL
;
230 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
231 VAR_DOMAIN
, &is_this_fld
);
235 wtype
= SYMBOL_TYPE (wsym
);
239 wtype
= TYPE_TARGET_TYPE (type
);
241 vt_val
= value_at (wtype
, vt_address
);
242 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
246 fprintf_filtered (stream
, "\n");
247 print_spaces_filtered (2 + 2 * recurse
, stream
);
252 /* Return number of characters printed, including the terminating
253 '\0' if we reached the end. val_print_string takes care including
254 the terminating '\0' if necessary. */
260 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
261 if (options
->addressprint
)
264 = extract_typed_address (valaddr
+ embedded_offset
, type
);
266 fprintf_filtered (stream
, "@");
267 fputs_filtered (paddress (gdbarch
, addr
), stream
);
268 if (options
->deref_ref
)
269 fputs_filtered (": ", stream
);
271 /* De-reference the reference. */
272 if (options
->deref_ref
)
274 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
276 struct value
*deref_val
=
278 (TYPE_TARGET_TYPE (type
),
279 unpack_pointer (type
, valaddr
+ embedded_offset
));
281 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
285 fputs_filtered ("???", stream
);
289 case TYPE_CODE_UNION
:
290 if (recurse
&& !options
->unionprint
)
292 fprintf_filtered (stream
, "{...}");
296 case TYPE_CODE_STRUCT
:
297 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
299 /* Print the unmangled name if desired. */
300 /* Print vtable entry - we only get here if NOT using
301 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
302 /* Extract the address, assume that it is unsigned. */
303 print_address_demangle
305 extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
306 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
)), byte_order
),
311 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
312 &string_pos
, &char_type
, NULL
))
314 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
, byte_order
);
315 LA_PRINT_STRING (stream
, char_type
,
316 valaddr
+ embedded_offset
+ string_pos
,
317 len
, NULL
, 0, options
);
320 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
321 recurse
, original_value
, options
, NULL
, 0);
328 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
332 len
= TYPE_NFIELDS (type
);
333 val
= unpack_long (type
, valaddr
+ embedded_offset
);
334 for (i
= 0; i
< len
; i
++)
337 if (val
== TYPE_FIELD_BITPOS (type
, i
))
344 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
348 print_longest (stream
, 'd', 0, val
);
352 case TYPE_CODE_FLAGS
:
354 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
357 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
363 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
367 /* FIXME, we should consider, at least for ANSI C language, eliminating
368 the distinction made between FUNCs and POINTERs to FUNCs. */
369 fprintf_filtered (stream
, "{");
370 type_print (type
, "", stream
, -1);
371 fprintf_filtered (stream
, "} ");
372 /* Try to print what function it points to, and its address. */
373 print_address_demangle (gdbarch
, address
, stream
, demangle
);
377 if (options
->format
|| options
->output_format
)
379 struct value_print_options opts
= *options
;
381 opts
.format
= (options
->format
? options
->format
382 : options
->output_format
);
383 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
388 val
= unpack_long (type
, valaddr
+ embedded_offset
);
390 fputs_filtered ("false", stream
);
392 fputs_filtered ("true", stream
);
395 fputs_filtered ("true (", stream
);
396 fprintf_filtered (stream
, "%ld)", (long int) val
);
401 case TYPE_CODE_RANGE
:
402 /* FIXME: create_range_type does not set the unsigned bit in a
403 range type (I think it probably should copy it from the target
404 type), so we won't print values which are too large to
405 fit in a signed integer correctly. */
406 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
407 print with the target type, though, because the size of our type
408 and the target type might differ). */
412 if (options
->format
|| options
->output_format
)
414 struct value_print_options opts
= *options
;
416 opts
.format
= (options
->format
? options
->format
417 : options
->output_format
);
418 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
423 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
428 if (options
->format
|| options
->output_format
)
430 struct value_print_options opts
= *options
;
432 opts
.format
= (options
->format
? options
->format
433 : options
->output_format
);
434 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
439 val
= unpack_long (type
, valaddr
+ embedded_offset
);
440 if (TYPE_UNSIGNED (type
))
441 fprintf_filtered (stream
, "%u", (unsigned int) val
);
443 fprintf_filtered (stream
, "%d", (int) val
);
444 fputs_filtered (" ", stream
);
445 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
452 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
457 print_floating (valaddr
+ embedded_offset
, type
, stream
);
461 case TYPE_CODE_BITSTRING
:
463 elttype
= TYPE_INDEX_TYPE (type
);
464 CHECK_TYPEDEF (elttype
);
465 if (TYPE_STUB (elttype
))
467 fprintf_filtered (stream
, "<incomplete type>");
473 struct type
*range
= elttype
;
474 LONGEST low_bound
, high_bound
;
476 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
480 fputs_filtered ("B'", stream
);
482 fputs_filtered ("[", stream
);
484 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
485 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
487 /* If we know the size of the set type, we can figure out the
490 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
491 TYPE_HIGH_BOUND (range
) = high_bound
;
496 fputs_filtered ("<error value>", stream
);
500 for (i
= low_bound
; i
<= high_bound
; i
++)
502 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
507 goto maybe_bad_bstring
;
510 fprintf_filtered (stream
, "%d", element
);
514 fputs_filtered (", ", stream
);
515 print_type_scalar (range
, i
, stream
);
518 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
522 fputs_filtered ("..", stream
);
523 while (i
+ 1 <= high_bound
524 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
526 print_type_scalar (range
, j
, stream
);
532 fputs_filtered ("'", stream
);
534 fputs_filtered ("]", stream
);
539 fprintf_filtered (stream
, "void");
542 case TYPE_CODE_ERROR
:
543 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
546 case TYPE_CODE_UNDEF
:
547 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
548 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
549 and no complete type for struct foo in that file. */
550 fprintf_filtered (stream
, "<incomplete type>");
554 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
561 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
562 const struct value_print_options
*options
)
564 struct type
*type
= value_type (val
);
565 struct value_print_options opts
= *options
;
569 /* If it is a pointer, indicate what it points to.
571 Print type also if it is a reference.
573 Object pascal: if it is a member pointer, we will take care
574 of that when we print it. */
575 if (TYPE_CODE (type
) == TYPE_CODE_PTR
576 || TYPE_CODE (type
) == TYPE_CODE_REF
)
578 /* Hack: remove (char *) for char strings. Their
579 type is indicated by the quoted string anyway. */
580 if (TYPE_CODE (type
) == TYPE_CODE_PTR
581 && TYPE_NAME (type
) == NULL
582 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
583 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
589 fprintf_filtered (stream
, "(");
590 type_print (type
, "", stream
, -1);
591 fprintf_filtered (stream
, ") ");
594 return common_val_print (val
, stream
, 0, &opts
, current_language
);
599 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
600 struct cmd_list_element
*c
, const char *value
)
602 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
606 static struct obstack dont_print_vb_obstack
;
607 static struct obstack dont_print_statmem_obstack
;
609 static void pascal_object_print_static_field (struct value
*,
610 struct ui_file
*, int,
611 const struct value_print_options
*);
613 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
614 CORE_ADDR
, struct ui_file
*, int,
615 const struct value
*,
616 const struct value_print_options
*,
619 /* It was changed to this after 2.4.5. */
620 const char pascal_vtbl_ptr_name
[] =
621 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
623 /* Return truth value for assertion that TYPE is of the type
624 "pointer to virtual function". */
627 pascal_object_is_vtbl_ptr_type (struct type
*type
)
629 char *typename
= type_name_no_tag (type
);
631 return (typename
!= NULL
632 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
635 /* Return truth value for the assertion that TYPE is of the type
636 "pointer to virtual function table". */
639 pascal_object_is_vtbl_member (struct type
*type
)
641 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
643 type
= TYPE_TARGET_TYPE (type
);
644 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
646 type
= TYPE_TARGET_TYPE (type
);
647 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
648 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
650 /* Virtual functions tables are full of pointers
651 to virtual functions. */
652 return pascal_object_is_vtbl_ptr_type (type
);
659 /* Mutually recursive subroutines of pascal_object_print_value and
660 c_val_print to print out a structure's fields:
661 pascal_object_print_value_fields and pascal_object_print_value.
663 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
664 same meanings as in pascal_object_print_value and c_val_print.
666 DONT_PRINT is an array of baseclass types that we
667 should not print, or zero if called from top level. */
670 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
671 CORE_ADDR address
, struct ui_file
*stream
,
673 const struct value
*val
,
674 const struct value_print_options
*options
,
675 struct type
**dont_print_vb
,
676 int dont_print_statmem
)
678 int i
, len
, n_baseclasses
;
679 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
681 CHECK_TYPEDEF (type
);
683 fprintf_filtered (stream
, "{");
684 len
= TYPE_NFIELDS (type
);
685 n_baseclasses
= TYPE_N_BASECLASSES (type
);
687 /* Print out baseclasses such that we don't print
688 duplicates of virtual baseclasses. */
689 if (n_baseclasses
> 0)
690 pascal_object_print_value (type
, valaddr
, address
, stream
,
691 recurse
+ 1, val
, options
, dont_print_vb
);
693 if (!len
&& n_baseclasses
== 1)
694 fprintf_filtered (stream
, "<No data fields>");
697 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
700 if (dont_print_statmem
== 0)
702 /* If we're at top level, carve out a completely fresh
703 chunk of the obstack and use that until this particular
704 invocation returns. */
705 obstack_finish (&dont_print_statmem_obstack
);
708 for (i
= n_baseclasses
; i
< len
; i
++)
710 /* If requested, skip printing of static fields. */
711 if (!options
->pascal_static_field_print
712 && field_is_static (&TYPE_FIELD (type
, i
)))
715 fprintf_filtered (stream
, ", ");
716 else if (n_baseclasses
> 0)
720 fprintf_filtered (stream
, "\n");
721 print_spaces_filtered (2 + 2 * recurse
, stream
);
722 fputs_filtered ("members of ", stream
);
723 fputs_filtered (type_name_no_tag (type
), stream
);
724 fputs_filtered (": ", stream
);
731 fprintf_filtered (stream
, "\n");
732 print_spaces_filtered (2 + 2 * recurse
, stream
);
736 wrap_here (n_spaces (2 + 2 * recurse
));
738 if (options
->inspect_it
)
740 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
741 fputs_filtered ("\"( ptr \"", stream
);
743 fputs_filtered ("\"( nodef \"", stream
);
744 if (field_is_static (&TYPE_FIELD (type
, i
)))
745 fputs_filtered ("static ", stream
);
746 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
748 DMGL_PARAMS
| DMGL_ANSI
);
749 fputs_filtered ("\" \"", stream
);
750 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
752 DMGL_PARAMS
| DMGL_ANSI
);
753 fputs_filtered ("\") \"", stream
);
757 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
759 if (field_is_static (&TYPE_FIELD (type
, i
)))
760 fputs_filtered ("static ", stream
);
761 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
763 DMGL_PARAMS
| DMGL_ANSI
);
764 annotate_field_name_end ();
765 fputs_filtered (" = ", stream
);
766 annotate_field_value ();
769 if (!field_is_static (&TYPE_FIELD (type
, i
))
770 && TYPE_FIELD_PACKED (type
, i
))
774 /* Bitfields require special handling, especially due to byte
776 if (TYPE_FIELD_IGNORE (type
, i
))
778 fputs_filtered ("<optimized out or zero length>", stream
);
780 else if (!value_bits_valid (val
, TYPE_FIELD_BITPOS (type
, i
),
781 TYPE_FIELD_BITSIZE (type
, i
)))
783 fputs_filtered (_("<value optimized out>"), stream
);
787 struct value_print_options opts
= *options
;
789 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
790 unpack_field_as_long (type
, valaddr
, i
));
793 common_val_print (v
, stream
, recurse
+ 1, &opts
,
799 if (TYPE_FIELD_IGNORE (type
, i
))
801 fputs_filtered ("<optimized out or zero length>", stream
);
803 else if (field_is_static (&TYPE_FIELD (type
, i
)))
805 /* struct value *v = value_static_field (type, i); v4.17 specific */
808 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
809 unpack_field_as_long (type
, valaddr
, i
));
812 fputs_filtered ("<optimized out>", stream
);
814 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
819 struct value_print_options opts
= *options
;
822 /* val_print (TYPE_FIELD_TYPE (type, i),
823 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
824 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
825 stream, format, 0, recurse + 1, pretty); */
826 val_print (TYPE_FIELD_TYPE (type
, i
),
827 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
828 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
829 stream
, recurse
+ 1, val
, &opts
,
833 annotate_field_end ();
836 if (dont_print_statmem
== 0)
838 /* Free the space used to deal with the printing
839 of the members from top level. */
840 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
841 dont_print_statmem_obstack
= tmp_obstack
;
846 fprintf_filtered (stream
, "\n");
847 print_spaces_filtered (2 * recurse
, stream
);
850 fprintf_filtered (stream
, "}");
853 /* Special val_print routine to avoid printing multiple copies of virtual
857 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
858 CORE_ADDR address
, struct ui_file
*stream
,
860 const struct value
*val
,
861 const struct value_print_options
*options
,
862 struct type
**dont_print_vb
)
864 struct type
**last_dont_print
865 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
866 struct obstack tmp_obstack
= dont_print_vb_obstack
;
867 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
869 if (dont_print_vb
== 0)
871 /* If we're at top level, carve out a completely fresh
872 chunk of the obstack and use that until this particular
873 invocation returns. */
874 /* Bump up the high-water mark. Now alpha is omega. */
875 obstack_finish (&dont_print_vb_obstack
);
878 for (i
= 0; i
< n_baseclasses
; i
++)
881 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
882 char *basename
= type_name_no_tag (baseclass
);
883 const gdb_byte
*base_valaddr
;
885 if (BASETYPE_VIA_VIRTUAL (type
, i
))
887 struct type
**first_dont_print
888 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
890 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
894 if (baseclass
== first_dont_print
[j
])
897 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
900 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
904 fprintf_filtered (stream
, "\n");
905 print_spaces_filtered (2 * recurse
, stream
);
907 fputs_filtered ("<", stream
);
908 /* Not sure what the best notation is in the case where there is no
911 fputs_filtered (basename
? basename
: "", stream
);
912 fputs_filtered ("> = ", stream
);
914 /* The virtual base class pointer might have been clobbered by the
915 user program. Make sure that it still points to a valid memory
918 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
920 /* FIXME (alloc): not safe is baseclass is really really big. */
921 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
924 if (target_read_memory (address
+ boffset
, buf
,
925 TYPE_LENGTH (baseclass
)) != 0)
929 base_valaddr
= valaddr
+ boffset
;
932 fprintf_filtered (stream
, "<invalid address>");
934 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
935 stream
, recurse
, val
, options
,
936 (struct type
**) obstack_base (&dont_print_vb_obstack
),
938 fputs_filtered (", ", stream
);
944 if (dont_print_vb
== 0)
946 /* Free the space used to deal with the printing
947 of this type from top level. */
948 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
949 /* Reset watermark so that we can continue protecting
950 ourselves from whatever we were protecting ourselves. */
951 dont_print_vb_obstack
= tmp_obstack
;
955 /* Print value of a static member.
956 To avoid infinite recursion when printing a class that contains
957 a static instance of the class, we keep the addresses of all printed
958 static member classes in an obstack and refuse to print them more
961 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
962 have the same meanings as in c_val_print. */
965 pascal_object_print_static_field (struct value
*val
,
966 struct ui_file
*stream
,
968 const struct value_print_options
*options
)
970 struct type
*type
= value_type (val
);
971 struct value_print_options opts
;
973 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
975 CORE_ADDR
*first_dont_print
, addr
;
979 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
980 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
985 if (value_address (val
) == first_dont_print
[i
])
987 fputs_filtered ("<same as static member of an already seen type>",
993 addr
= value_address (val
);
994 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
997 CHECK_TYPEDEF (type
);
998 pascal_object_print_value_fields (type
, value_contents (val
), addr
,
999 stream
, recurse
, NULL
, options
,
1006 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
1009 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
1012 _initialize_pascal_valprint (void)
1014 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
1015 &user_print_options
.pascal_static_field_print
, _("\
1016 Set printing of pascal static members."), _("\
1017 Show printing of pascal static members."), NULL
,
1019 show_pascal_static_field_print
,
1020 &setprintlist
, &showprintlist
);