1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009, 2010, 2011
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"
43 /* See val_print for a description of the various parameters of this
44 function; they are identical. The semantics of the return value is
45 also identical to val_print. */
48 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
49 int embedded_offset
, CORE_ADDR address
,
50 struct ui_file
*stream
, int recurse
,
51 const struct value
*original_value
,
52 const struct value_print_options
*options
)
54 struct gdbarch
*gdbarch
= get_type_arch (type
);
55 enum bfd_endian byte_order
= gdbarch_byte_order (gdbarch
);
56 unsigned int i
= 0; /* Number of characters printed */
58 LONGEST low_bound
, high_bound
;
61 int length_pos
, length_size
, string_pos
;
62 struct type
*char_type
;
67 switch (TYPE_CODE (type
))
70 if (get_array_bounds (type
, &low_bound
, &high_bound
))
72 len
= high_bound
- low_bound
+ 1;
73 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
74 eltlen
= TYPE_LENGTH (elttype
);
75 if (options
->prettyprint_arrays
)
77 print_spaces_filtered (2 + 2 * recurse
, stream
);
79 /* If 's' format is used, try to print out as string.
80 If no format is given, print as string if element type
81 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
82 if (options
->format
== 's'
83 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
84 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
85 && options
->format
== 0))
87 /* If requested, look for the first null char and only print
89 if (options
->stop_print_at_null
)
91 unsigned int temp_len
;
93 /* Look for a NULL char. */
95 extract_unsigned_integer (valaddr
+ embedded_offset
+
96 temp_len
* eltlen
, eltlen
,
98 && temp_len
< len
&& temp_len
< options
->print_max
;
103 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
104 valaddr
+ embedded_offset
, len
, NULL
, 0,
110 fprintf_filtered (stream
, "{");
111 /* If this is a virtual function table, print the 0th
112 entry specially, and the rest of the members normally. */
113 if (pascal_object_is_vtbl_ptr_type (elttype
))
116 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
122 val_print_array_elements (type
, valaddr
, embedded_offset
,
123 address
, stream
, recurse
,
124 original_value
, 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 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
137 original_value
, options
, 0, stream
);
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 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
147 TYPE_LENGTH (type
), byte_order
);
148 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
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
, NULL
, 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
;
195 buffer
= xmalloc (length_size
);
196 read_memory (addr
+ length_pos
, buffer
, length_size
);
197 string_length
= extract_unsigned_integer (buffer
, length_size
,
200 i
= val_print_string (char_type
, NULL
,
201 addr
+ string_pos
, string_length
,
204 else if (pascal_object_is_vtbl_member (type
))
206 /* Print vtbl's nicely. */
207 CORE_ADDR vt_address
= unpack_pointer (type
,
208 valaddr
+ embedded_offset
);
209 struct minimal_symbol
*msymbol
=
210 lookup_minimal_symbol_by_pc (vt_address
);
212 if ((msymbol
!= NULL
)
213 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
215 fputs_filtered (" <", stream
);
216 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
217 fputs_filtered (">", stream
);
219 if (vt_address
&& options
->vtblprint
)
221 struct value
*vt_val
;
222 struct symbol
*wsym
= (struct symbol
*) NULL
;
224 struct block
*block
= (struct block
*) NULL
;
228 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
229 VAR_DOMAIN
, &is_this_fld
);
233 wtype
= SYMBOL_TYPE (wsym
);
237 wtype
= TYPE_TARGET_TYPE (type
);
239 vt_val
= value_at (wtype
, vt_address
);
240 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
244 fprintf_filtered (stream
, "\n");
245 print_spaces_filtered (2 + 2 * recurse
, stream
);
250 /* Return number of characters printed, including the terminating
251 '\0' if we reached the end. val_print_string takes care including
252 the terminating '\0' if necessary. */
258 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
259 if (options
->addressprint
)
262 = extract_typed_address (valaddr
+ embedded_offset
, type
);
264 fprintf_filtered (stream
, "@");
265 fputs_filtered (paddress (gdbarch
, addr
), stream
);
266 if (options
->deref_ref
)
267 fputs_filtered (": ", stream
);
269 /* De-reference the reference. */
270 if (options
->deref_ref
)
272 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
274 struct value
*deref_val
=
276 (TYPE_TARGET_TYPE (type
),
277 unpack_pointer (type
, valaddr
+ embedded_offset
));
279 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
283 fputs_filtered ("???", stream
);
287 case TYPE_CODE_UNION
:
288 if (recurse
&& !options
->unionprint
)
290 fprintf_filtered (stream
, "{...}");
294 case TYPE_CODE_STRUCT
:
295 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
297 /* Print the unmangled name if desired. */
298 /* Print vtable entry - we only get here if NOT using
299 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
300 /* Extract the address, assume that it is unsigned. */
301 print_address_demangle
303 extract_unsigned_integer (valaddr
+ embedded_offset
304 + TYPE_FIELD_BITPOS (type
,
305 VTBL_FNADDR_OFFSET
) / 8,
306 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
307 VTBL_FNADDR_OFFSET
)),
313 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
314 &string_pos
, &char_type
, NULL
))
316 len
= extract_unsigned_integer (valaddr
+ embedded_offset
317 + length_pos
, length_size
,
319 LA_PRINT_STRING (stream
, char_type
,
320 valaddr
+ embedded_offset
+ string_pos
,
321 len
, NULL
, 0, options
);
324 pascal_object_print_value_fields (type
, valaddr
, embedded_offset
,
325 address
, stream
, recurse
,
326 original_value
, options
,
334 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
335 original_value
, options
, 0, stream
);
338 len
= TYPE_NFIELDS (type
);
339 val
= unpack_long (type
, valaddr
+ embedded_offset
);
340 for (i
= 0; i
< len
; i
++)
343 if (val
== TYPE_FIELD_BITPOS (type
, i
))
350 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
354 print_longest (stream
, 'd', 0, val
);
358 case TYPE_CODE_FLAGS
:
360 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
361 original_value
, options
, 0, stream
);
363 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
369 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
370 original_value
, options
, 0, stream
);
373 /* FIXME, we should consider, at least for ANSI C language, eliminating
374 the distinction made between FUNCs and POINTERs to FUNCs. */
375 fprintf_filtered (stream
, "{");
376 type_print (type
, "", stream
, -1);
377 fprintf_filtered (stream
, "} ");
378 /* Try to print what function it points to, and its address. */
379 print_address_demangle (gdbarch
, address
, stream
, demangle
);
383 if (options
->format
|| options
->output_format
)
385 struct value_print_options opts
= *options
;
387 opts
.format
= (options
->format
? options
->format
388 : options
->output_format
);
389 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
390 original_value
, &opts
, 0, stream
);
394 val
= unpack_long (type
, valaddr
+ embedded_offset
);
396 fputs_filtered ("false", stream
);
398 fputs_filtered ("true", stream
);
401 fputs_filtered ("true (", stream
);
402 fprintf_filtered (stream
, "%ld)", (long int) val
);
407 case TYPE_CODE_RANGE
:
408 /* FIXME: create_range_type does not set the unsigned bit in a
409 range type (I think it probably should copy it from the target
410 type), so we won't print values which are too large to
411 fit in a signed integer correctly. */
412 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
413 print with the target type, though, because the size of our type
414 and the target type might differ). */
418 if (options
->format
|| options
->output_format
)
420 struct value_print_options opts
= *options
;
422 opts
.format
= (options
->format
? options
->format
423 : options
->output_format
);
424 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
425 original_value
, &opts
, 0, stream
);
429 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
434 if (options
->format
|| options
->output_format
)
436 struct value_print_options opts
= *options
;
438 opts
.format
= (options
->format
? options
->format
439 : options
->output_format
);
440 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
441 original_value
, &opts
, 0, stream
);
445 val
= unpack_long (type
, valaddr
+ embedded_offset
);
446 if (TYPE_UNSIGNED (type
))
447 fprintf_filtered (stream
, "%u", (unsigned int) val
);
449 fprintf_filtered (stream
, "%d", (int) val
);
450 fputs_filtered (" ", stream
);
451 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
458 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
459 original_value
, options
, 0, stream
);
463 print_floating (valaddr
+ embedded_offset
, type
, stream
);
467 case TYPE_CODE_BITSTRING
:
469 elttype
= TYPE_INDEX_TYPE (type
);
470 CHECK_TYPEDEF (elttype
);
471 if (TYPE_STUB (elttype
))
473 fprintf_filtered (stream
, "<incomplete type>");
479 struct type
*range
= elttype
;
480 LONGEST low_bound
, high_bound
;
482 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
486 fputs_filtered ("B'", stream
);
488 fputs_filtered ("[", stream
);
490 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
491 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
493 /* If we know the size of the set type, we can figure out the
496 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
497 TYPE_HIGH_BOUND (range
) = high_bound
;
502 fputs_filtered ("<error value>", stream
);
506 for (i
= low_bound
; i
<= high_bound
; i
++)
508 int element
= value_bit_index (type
,
509 valaddr
+ embedded_offset
, i
);
514 goto maybe_bad_bstring
;
517 fprintf_filtered (stream
, "%d", element
);
521 fputs_filtered (", ", stream
);
522 print_type_scalar (range
, i
, stream
);
525 if (i
+ 1 <= high_bound
526 && value_bit_index (type
,
527 valaddr
+ embedded_offset
, ++i
))
531 fputs_filtered ("..", stream
);
532 while (i
+ 1 <= high_bound
533 && value_bit_index (type
,
534 valaddr
+ embedded_offset
,
537 print_type_scalar (range
, j
, stream
);
543 fputs_filtered ("'", stream
);
545 fputs_filtered ("]", stream
);
550 fprintf_filtered (stream
, "void");
553 case TYPE_CODE_ERROR
:
554 fprintf_filtered (stream
, "%s", TYPE_ERROR_NAME (type
));
557 case TYPE_CODE_UNDEF
:
558 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
559 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
560 and no complete type for struct foo in that file. */
561 fprintf_filtered (stream
, "<incomplete type>");
565 error (_("Invalid pascal type code %d in symbol table."),
573 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
574 const struct value_print_options
*options
)
576 struct type
*type
= value_type (val
);
577 struct value_print_options opts
= *options
;
581 /* If it is a pointer, indicate what it points to.
583 Print type also if it is a reference.
585 Object pascal: if it is a member pointer, we will take care
586 of that when we print it. */
587 if (TYPE_CODE (type
) == TYPE_CODE_PTR
588 || TYPE_CODE (type
) == TYPE_CODE_REF
)
590 /* Hack: remove (char *) for char strings. Their
591 type is indicated by the quoted string anyway. */
592 if (TYPE_CODE (type
) == TYPE_CODE_PTR
593 && TYPE_NAME (type
) == NULL
594 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
595 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
601 fprintf_filtered (stream
, "(");
602 type_print (type
, "", stream
, -1);
603 fprintf_filtered (stream
, ") ");
606 return common_val_print (val
, stream
, 0, &opts
, current_language
);
611 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
612 struct cmd_list_element
*c
, const char *value
)
614 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
618 static struct obstack dont_print_vb_obstack
;
619 static struct obstack dont_print_statmem_obstack
;
621 static void pascal_object_print_static_field (struct value
*,
622 struct ui_file
*, int,
623 const struct value_print_options
*);
625 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
627 CORE_ADDR
, struct ui_file
*, int,
628 const struct value
*,
629 const struct value_print_options
*,
632 /* It was changed to this after 2.4.5. */
633 const char pascal_vtbl_ptr_name
[] =
634 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
636 /* Return truth value for assertion that TYPE is of the type
637 "pointer to virtual function". */
640 pascal_object_is_vtbl_ptr_type (struct type
*type
)
642 char *typename
= type_name_no_tag (type
);
644 return (typename
!= NULL
645 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
648 /* Return truth value for the assertion that TYPE is of the type
649 "pointer to virtual function table". */
652 pascal_object_is_vtbl_member (struct type
*type
)
654 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
656 type
= TYPE_TARGET_TYPE (type
);
657 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
659 type
= TYPE_TARGET_TYPE (type
);
660 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* If not using
662 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* If using thunks. */
664 /* Virtual functions tables are full of pointers
665 to virtual functions. */
666 return pascal_object_is_vtbl_ptr_type (type
);
673 /* Mutually recursive subroutines of pascal_object_print_value and
674 c_val_print to print out a structure's fields:
675 pascal_object_print_value_fields and pascal_object_print_value.
677 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
678 same meanings as in pascal_object_print_value and c_val_print.
680 DONT_PRINT is an array of baseclass types that we
681 should not print, or zero if called from top level. */
684 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
686 CORE_ADDR address
, struct ui_file
*stream
,
688 const struct value
*val
,
689 const struct value_print_options
*options
,
690 struct type
**dont_print_vb
,
691 int dont_print_statmem
)
693 int i
, len
, n_baseclasses
;
694 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
696 CHECK_TYPEDEF (type
);
698 fprintf_filtered (stream
, "{");
699 len
= TYPE_NFIELDS (type
);
700 n_baseclasses
= TYPE_N_BASECLASSES (type
);
702 /* Print out baseclasses such that we don't print
703 duplicates of virtual baseclasses. */
704 if (n_baseclasses
> 0)
705 pascal_object_print_value (type
, valaddr
, offset
, address
,
706 stream
, recurse
+ 1, val
,
707 options
, dont_print_vb
);
709 if (!len
&& n_baseclasses
== 1)
710 fprintf_filtered (stream
, "<No data fields>");
713 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
716 if (dont_print_statmem
== 0)
718 /* If we're at top level, carve out a completely fresh
719 chunk of the obstack and use that until this particular
720 invocation returns. */
721 obstack_finish (&dont_print_statmem_obstack
);
724 for (i
= n_baseclasses
; i
< len
; i
++)
726 /* If requested, skip printing of static fields. */
727 if (!options
->pascal_static_field_print
728 && field_is_static (&TYPE_FIELD (type
, i
)))
731 fprintf_filtered (stream
, ", ");
732 else if (n_baseclasses
> 0)
736 fprintf_filtered (stream
, "\n");
737 print_spaces_filtered (2 + 2 * recurse
, stream
);
738 fputs_filtered ("members of ", stream
);
739 fputs_filtered (type_name_no_tag (type
), stream
);
740 fputs_filtered (": ", stream
);
747 fprintf_filtered (stream
, "\n");
748 print_spaces_filtered (2 + 2 * recurse
, stream
);
752 wrap_here (n_spaces (2 + 2 * recurse
));
754 if (options
->inspect_it
)
756 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
757 fputs_filtered ("\"( ptr \"", stream
);
759 fputs_filtered ("\"( nodef \"", stream
);
760 if (field_is_static (&TYPE_FIELD (type
, i
)))
761 fputs_filtered ("static ", stream
);
762 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
764 DMGL_PARAMS
| DMGL_ANSI
);
765 fputs_filtered ("\" \"", stream
);
766 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
768 DMGL_PARAMS
| DMGL_ANSI
);
769 fputs_filtered ("\") \"", stream
);
773 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
775 if (field_is_static (&TYPE_FIELD (type
, i
)))
776 fputs_filtered ("static ", stream
);
777 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
779 DMGL_PARAMS
| DMGL_ANSI
);
780 annotate_field_name_end ();
781 fputs_filtered (" = ", stream
);
782 annotate_field_value ();
785 if (!field_is_static (&TYPE_FIELD (type
, i
))
786 && TYPE_FIELD_PACKED (type
, i
))
790 /* Bitfields require special handling, especially due to byte
792 if (TYPE_FIELD_IGNORE (type
, i
))
794 fputs_filtered ("<optimized out or zero length>", stream
);
796 else if (value_bits_synthetic_pointer (val
,
797 TYPE_FIELD_BITPOS (type
,
799 TYPE_FIELD_BITSIZE (type
,
802 fputs_filtered (_("<synthetic pointer>"), stream
);
804 else if (!value_bits_valid (val
, TYPE_FIELD_BITPOS (type
, i
),
805 TYPE_FIELD_BITSIZE (type
, i
)))
807 val_print_optimized_out (stream
);
811 struct value_print_options opts
= *options
;
813 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
814 unpack_field_as_long (type
,
815 valaddr
+ offset
, i
));
818 common_val_print (v
, stream
, recurse
+ 1, &opts
,
824 if (TYPE_FIELD_IGNORE (type
, i
))
826 fputs_filtered ("<optimized out or zero length>", stream
);
828 else if (field_is_static (&TYPE_FIELD (type
, i
)))
830 /* struct value *v = value_static_field (type, i);
834 v
= value_from_longest
835 (TYPE_FIELD_TYPE (type
, i
),
836 unpack_field_as_long (type
, valaddr
+ offset
, i
));
839 val_print_optimized_out (stream
);
841 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
846 struct value_print_options opts
= *options
;
849 /* val_print (TYPE_FIELD_TYPE (type, i),
850 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
851 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
852 stream, format, 0, recurse + 1, pretty); */
853 val_print (TYPE_FIELD_TYPE (type
, i
),
854 valaddr
, offset
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
855 address
, stream
, recurse
+ 1, val
, &opts
,
859 annotate_field_end ();
862 if (dont_print_statmem
== 0)
864 /* Free the space used to deal with the printing
865 of the members from top level. */
866 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
867 dont_print_statmem_obstack
= tmp_obstack
;
872 fprintf_filtered (stream
, "\n");
873 print_spaces_filtered (2 * recurse
, stream
);
876 fprintf_filtered (stream
, "}");
879 /* Special val_print routine to avoid printing multiple copies of virtual
883 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
885 CORE_ADDR address
, struct ui_file
*stream
,
887 const struct value
*val
,
888 const struct value_print_options
*options
,
889 struct type
**dont_print_vb
)
891 struct type
**last_dont_print
892 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
893 struct obstack tmp_obstack
= dont_print_vb_obstack
;
894 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
896 if (dont_print_vb
== 0)
898 /* If we're at top level, carve out a completely fresh
899 chunk of the obstack and use that until this particular
900 invocation returns. */
901 /* Bump up the high-water mark. Now alpha is omega. */
902 obstack_finish (&dont_print_vb_obstack
);
905 for (i
= 0; i
< n_baseclasses
; i
++)
908 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
909 char *basename
= type_name_no_tag (baseclass
);
910 const gdb_byte
*base_valaddr
;
913 if (BASETYPE_VIA_VIRTUAL (type
, i
))
915 struct type
**first_dont_print
916 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
918 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
922 if (baseclass
== first_dont_print
[j
])
925 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
930 boffset
= baseclass_offset (type
, i
, valaddr
+ offset
, address
+ offset
);
934 fprintf_filtered (stream
, "\n");
935 print_spaces_filtered (2 * recurse
, stream
);
937 fputs_filtered ("<", stream
);
938 /* Not sure what the best notation is in the case where there is no
941 fputs_filtered (basename
? basename
: "", stream
);
942 fputs_filtered ("> = ", stream
);
944 /* The virtual base class pointer might have been clobbered by the
945 user program. Make sure that it still points to a valid memory
948 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
950 /* FIXME (alloc): not safe is baseclass is really really big. */
951 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
954 if (target_read_memory (address
+ boffset
, buf
,
955 TYPE_LENGTH (baseclass
)) != 0)
957 address
= address
+ boffset
;
962 base_valaddr
= valaddr
;
965 fprintf_filtered (stream
, "<invalid address>");
967 pascal_object_print_value_fields (baseclass
, base_valaddr
,
968 thisoffset
+ boffset
, address
,
969 stream
, recurse
, val
, options
,
970 (struct type
**) obstack_base (&dont_print_vb_obstack
),
972 fputs_filtered (", ", stream
);
978 if (dont_print_vb
== 0)
980 /* Free the space used to deal with the printing
981 of this type from top level. */
982 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
983 /* Reset watermark so that we can continue protecting
984 ourselves from whatever we were protecting ourselves. */
985 dont_print_vb_obstack
= tmp_obstack
;
989 /* Print value of a static member.
990 To avoid infinite recursion when printing a class that contains
991 a static instance of the class, we keep the addresses of all printed
992 static member classes in an obstack and refuse to print them more
995 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
996 have the same meanings as in c_val_print. */
999 pascal_object_print_static_field (struct value
*val
,
1000 struct ui_file
*stream
,
1002 const struct value_print_options
*options
)
1004 struct type
*type
= value_type (val
);
1005 struct value_print_options opts
;
1007 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1009 CORE_ADDR
*first_dont_print
, addr
;
1013 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1014 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1019 if (value_address (val
) == first_dont_print
[i
])
1022 <same as static member of an already seen type>",
1028 addr
= value_address (val
);
1029 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
1030 sizeof (CORE_ADDR
));
1032 CHECK_TYPEDEF (type
);
1033 pascal_object_print_value_fields (type
,
1034 value_contents_for_printing (val
),
1035 value_embedded_offset (val
),
1038 val
, options
, NULL
, 1);
1044 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
1047 /* -Wmissing-prototypes */
1048 extern initialize_file_ftype _initialize_pascal_valprint
;
1051 _initialize_pascal_valprint (void)
1053 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
1054 &user_print_options
.pascal_static_field_print
, _("\
1055 Set printing of pascal static members."), _("\
1056 Show printing of pascal static members."), NULL
,
1058 show_pascal_static_field_print
,
1059 &setprintlist
, &showprintlist
);