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 /* If 's' format is used, try to print out as string.
84 If no format is given, print as string if element type
85 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
86 if (options
->format
== 's'
87 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
88 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
89 && options
->format
== 0))
91 /* If requested, look for the first null char and only print
93 if (options
->stop_print_at_null
)
95 unsigned int temp_len
;
97 /* Look for a NULL char. */
99 extract_unsigned_integer (valaddr
+ embedded_offset
+
100 temp_len
* eltlen
, eltlen
,
102 && temp_len
< len
&& temp_len
< options
->print_max
;
107 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
108 valaddr
+ embedded_offset
, len
, NULL
, 0,
114 fprintf_filtered (stream
, "{");
115 /* If this is a virtual function table, print the 0th
116 entry specially, and the rest of the members normally. */
117 if (pascal_object_is_vtbl_ptr_type (elttype
))
120 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
126 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
127 recurse
, options
, i
);
128 fprintf_filtered (stream
, "}");
132 /* Array of unspecified length: treat like pointer to first elt. */
134 goto print_unpacked_pointer
;
137 if (options
->format
&& options
->format
!= 's')
139 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
143 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
145 /* Print the unmangled name if desired. */
146 /* Print vtable entry - we only get here if we ARE using
147 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
148 /* Extract the address, assume that it is unsigned. */
149 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
150 TYPE_LENGTH (type
), byte_order
);
151 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
154 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
156 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
157 print_unpacked_pointer
:
158 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
160 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
162 /* Try to print what function it points to. */
163 print_address_demangle (gdbarch
, addr
, stream
, demangle
);
164 /* Return value is irrelevant except for string pointers. */
168 if (options
->addressprint
&& options
->format
!= 's')
170 fputs_filtered (paddress (gdbarch
, addr
), stream
);
173 /* For a pointer to char or unsigned char, also print the string
174 pointed to, unless pointer is null. */
175 if (((TYPE_LENGTH (elttype
) == 1
176 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
177 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
178 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
179 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
180 && (options
->format
== 0 || options
->format
== 's')
183 /* no wide string yet */
184 i
= val_print_string (elttype
, addr
, -1, stream
, options
);
186 /* also for pointers to pascal strings */
187 /* Note: this is Free Pascal specific:
188 as GDB does not recognize stabs pascal strings
189 Pascal strings are mapped to records
190 with lowercase names PM */
191 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
192 &string_pos
, &char_type
, NULL
)
195 ULONGEST string_length
;
198 buffer
= xmalloc (length_size
);
199 read_memory (addr
+ length_pos
, buffer
, length_size
);
200 string_length
= extract_unsigned_integer (buffer
, length_size
,
203 i
= val_print_string (char_type
,addr
+ string_pos
, string_length
, stream
, options
);
205 else if (pascal_object_is_vtbl_member (type
))
207 /* print vtbl's nicely */
208 CORE_ADDR vt_address
= unpack_pointer (type
, 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
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
304 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
)), byte_order
),
309 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
310 &string_pos
, &char_type
, NULL
))
312 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
, byte_order
);
313 LA_PRINT_STRING (stream
, char_type
,
314 valaddr
+ embedded_offset
+ string_pos
,
315 len
, NULL
, 0, options
);
318 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
319 recurse
, options
, NULL
, 0);
326 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
330 len
= TYPE_NFIELDS (type
);
331 val
= unpack_long (type
, valaddr
+ embedded_offset
);
332 for (i
= 0; i
< len
; i
++)
335 if (val
== TYPE_FIELD_BITPOS (type
, i
))
342 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
346 print_longest (stream
, 'd', 0, val
);
350 case TYPE_CODE_FLAGS
:
352 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
355 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
361 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
365 /* FIXME, we should consider, at least for ANSI C language, eliminating
366 the distinction made between FUNCs and POINTERs to FUNCs. */
367 fprintf_filtered (stream
, "{");
368 type_print (type
, "", stream
, -1);
369 fprintf_filtered (stream
, "} ");
370 /* Try to print what function it points to, and its address. */
371 print_address_demangle (gdbarch
, address
, stream
, demangle
);
375 if (options
->format
|| options
->output_format
)
377 struct value_print_options opts
= *options
;
379 opts
.format
= (options
->format
? options
->format
380 : options
->output_format
);
381 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
386 val
= unpack_long (type
, valaddr
+ embedded_offset
);
388 fputs_filtered ("false", stream
);
390 fputs_filtered ("true", stream
);
393 fputs_filtered ("true (", stream
);
394 fprintf_filtered (stream
, "%ld)", (long int) val
);
399 case TYPE_CODE_RANGE
:
400 /* FIXME: create_range_type does not set the unsigned bit in a
401 range type (I think it probably should copy it from the target
402 type), so we won't print values which are too large to
403 fit in a signed integer correctly. */
404 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
405 print with the target type, though, because the size of our type
406 and the target type might differ). */
410 if (options
->format
|| options
->output_format
)
412 struct value_print_options opts
= *options
;
414 opts
.format
= (options
->format
? options
->format
415 : options
->output_format
);
416 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
421 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
426 if (options
->format
|| options
->output_format
)
428 struct value_print_options opts
= *options
;
430 opts
.format
= (options
->format
? options
->format
431 : options
->output_format
);
432 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
437 val
= unpack_long (type
, valaddr
+ embedded_offset
);
438 if (TYPE_UNSIGNED (type
))
439 fprintf_filtered (stream
, "%u", (unsigned int) val
);
441 fprintf_filtered (stream
, "%d", (int) val
);
442 fputs_filtered (" ", stream
);
443 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
450 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
455 print_floating (valaddr
+ embedded_offset
, type
, stream
);
459 case TYPE_CODE_BITSTRING
:
461 elttype
= TYPE_INDEX_TYPE (type
);
462 CHECK_TYPEDEF (elttype
);
463 if (TYPE_STUB (elttype
))
465 fprintf_filtered (stream
, "<incomplete type>");
471 struct type
*range
= elttype
;
472 LONGEST low_bound
, high_bound
;
474 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
478 fputs_filtered ("B'", stream
);
480 fputs_filtered ("[", stream
);
482 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
486 fputs_filtered ("<error value>", stream
);
490 for (i
= low_bound
; i
<= high_bound
; i
++)
492 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
497 goto maybe_bad_bstring
;
500 fprintf_filtered (stream
, "%d", element
);
504 fputs_filtered (", ", stream
);
505 print_type_scalar (range
, i
, stream
);
508 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
512 fputs_filtered ("..", stream
);
513 while (i
+ 1 <= high_bound
514 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
516 print_type_scalar (range
, j
, stream
);
522 fputs_filtered ("'", stream
);
524 fputs_filtered ("]", stream
);
529 fprintf_filtered (stream
, "void");
532 case TYPE_CODE_ERROR
:
533 fprintf_filtered (stream
, "<error type>");
536 case TYPE_CODE_UNDEF
:
537 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
538 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
539 and no complete type for struct foo in that file. */
540 fprintf_filtered (stream
, "<incomplete type>");
544 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
551 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
552 const struct value_print_options
*options
)
554 struct type
*type
= value_type (val
);
555 struct value_print_options opts
= *options
;
559 /* If it is a pointer, indicate what it points to.
561 Print type also if it is a reference.
563 Object pascal: if it is a member pointer, we will take care
564 of that when we print it. */
565 if (TYPE_CODE (type
) == TYPE_CODE_PTR
566 || TYPE_CODE (type
) == TYPE_CODE_REF
)
568 /* Hack: remove (char *) for char strings. Their
569 type is indicated by the quoted string anyway. */
570 if (TYPE_CODE (type
) == TYPE_CODE_PTR
571 && TYPE_NAME (type
) == NULL
572 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
573 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
579 fprintf_filtered (stream
, "(");
580 type_print (type
, "", stream
, -1);
581 fprintf_filtered (stream
, ") ");
584 return common_val_print (val
, stream
, 0, &opts
, current_language
);
589 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
590 struct cmd_list_element
*c
, const char *value
)
592 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
596 static struct obstack dont_print_vb_obstack
;
597 static struct obstack dont_print_statmem_obstack
;
599 static void pascal_object_print_static_field (struct value
*,
600 struct ui_file
*, int,
601 const struct value_print_options
*);
603 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
604 CORE_ADDR
, struct ui_file
*, int,
605 const struct value_print_options
*,
608 /* It was changed to this after 2.4.5. */
609 const char pascal_vtbl_ptr_name
[] =
610 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
612 /* Return truth value for assertion that TYPE is of the type
613 "pointer to virtual function". */
616 pascal_object_is_vtbl_ptr_type (struct type
*type
)
618 char *typename
= type_name_no_tag (type
);
620 return (typename
!= NULL
621 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
624 /* Return truth value for the assertion that TYPE is of the type
625 "pointer to virtual function table". */
628 pascal_object_is_vtbl_member (struct type
*type
)
630 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
632 type
= TYPE_TARGET_TYPE (type
);
633 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
635 type
= TYPE_TARGET_TYPE (type
);
636 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
637 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
639 /* Virtual functions tables are full of pointers
640 to virtual functions. */
641 return pascal_object_is_vtbl_ptr_type (type
);
648 /* Mutually recursive subroutines of pascal_object_print_value and
649 c_val_print to print out a structure's fields:
650 pascal_object_print_value_fields and pascal_object_print_value.
652 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
653 same meanings as in pascal_object_print_value and c_val_print.
655 DONT_PRINT is an array of baseclass types that we
656 should not print, or zero if called from top level. */
659 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
660 CORE_ADDR address
, struct ui_file
*stream
,
662 const struct value_print_options
*options
,
663 struct type
**dont_print_vb
,
664 int dont_print_statmem
)
666 int i
, len
, n_baseclasses
;
667 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
669 CHECK_TYPEDEF (type
);
671 fprintf_filtered (stream
, "{");
672 len
= TYPE_NFIELDS (type
);
673 n_baseclasses
= TYPE_N_BASECLASSES (type
);
675 /* Print out baseclasses such that we don't print
676 duplicates of virtual baseclasses. */
677 if (n_baseclasses
> 0)
678 pascal_object_print_value (type
, valaddr
, address
, stream
,
679 recurse
+ 1, options
, dont_print_vb
);
681 if (!len
&& n_baseclasses
== 1)
682 fprintf_filtered (stream
, "<No data fields>");
685 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
688 if (dont_print_statmem
== 0)
690 /* If we're at top level, carve out a completely fresh
691 chunk of the obstack and use that until this particular
692 invocation returns. */
693 obstack_finish (&dont_print_statmem_obstack
);
696 for (i
= n_baseclasses
; i
< len
; i
++)
698 /* If requested, skip printing of static fields. */
699 if (!options
->pascal_static_field_print
700 && field_is_static (&TYPE_FIELD (type
, i
)))
703 fprintf_filtered (stream
, ", ");
704 else if (n_baseclasses
> 0)
708 fprintf_filtered (stream
, "\n");
709 print_spaces_filtered (2 + 2 * recurse
, stream
);
710 fputs_filtered ("members of ", stream
);
711 fputs_filtered (type_name_no_tag (type
), stream
);
712 fputs_filtered (": ", stream
);
719 fprintf_filtered (stream
, "\n");
720 print_spaces_filtered (2 + 2 * recurse
, stream
);
724 wrap_here (n_spaces (2 + 2 * recurse
));
726 if (options
->inspect_it
)
728 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
729 fputs_filtered ("\"( ptr \"", stream
);
731 fputs_filtered ("\"( nodef \"", stream
);
732 if (field_is_static (&TYPE_FIELD (type
, i
)))
733 fputs_filtered ("static ", stream
);
734 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
736 DMGL_PARAMS
| DMGL_ANSI
);
737 fputs_filtered ("\" \"", stream
);
738 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
740 DMGL_PARAMS
| DMGL_ANSI
);
741 fputs_filtered ("\") \"", stream
);
745 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
747 if (field_is_static (&TYPE_FIELD (type
, i
)))
748 fputs_filtered ("static ", stream
);
749 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
751 DMGL_PARAMS
| DMGL_ANSI
);
752 annotate_field_name_end ();
753 fputs_filtered (" = ", stream
);
754 annotate_field_value ();
757 if (!field_is_static (&TYPE_FIELD (type
, i
))
758 && TYPE_FIELD_PACKED (type
, i
))
762 /* Bitfields require special handling, especially due to byte
764 if (TYPE_FIELD_IGNORE (type
, i
))
766 fputs_filtered ("<optimized out or zero length>", stream
);
770 struct value_print_options opts
= *options
;
772 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
773 unpack_field_as_long (type
, valaddr
, i
));
776 common_val_print (v
, stream
, recurse
+ 1, &opts
,
782 if (TYPE_FIELD_IGNORE (type
, i
))
784 fputs_filtered ("<optimized out or zero length>", stream
);
786 else if (field_is_static (&TYPE_FIELD (type
, i
)))
788 /* struct value *v = value_static_field (type, i); v4.17 specific */
791 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
792 unpack_field_as_long (type
, valaddr
, i
));
795 fputs_filtered ("<optimized out>", stream
);
797 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
802 struct value_print_options opts
= *options
;
805 /* val_print (TYPE_FIELD_TYPE (type, i),
806 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
807 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
808 stream, format, 0, recurse + 1, pretty); */
809 val_print (TYPE_FIELD_TYPE (type
, i
),
810 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
811 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
812 stream
, recurse
+ 1, &opts
,
816 annotate_field_end ();
819 if (dont_print_statmem
== 0)
821 /* Free the space used to deal with the printing
822 of the members from top level. */
823 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
824 dont_print_statmem_obstack
= tmp_obstack
;
829 fprintf_filtered (stream
, "\n");
830 print_spaces_filtered (2 * recurse
, stream
);
833 fprintf_filtered (stream
, "}");
836 /* Special val_print routine to avoid printing multiple copies of virtual
840 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
841 CORE_ADDR address
, struct ui_file
*stream
,
843 const struct value_print_options
*options
,
844 struct type
**dont_print_vb
)
846 struct type
**last_dont_print
847 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
848 struct obstack tmp_obstack
= dont_print_vb_obstack
;
849 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
851 if (dont_print_vb
== 0)
853 /* If we're at top level, carve out a completely fresh
854 chunk of the obstack and use that until this particular
855 invocation returns. */
856 /* Bump up the high-water mark. Now alpha is omega. */
857 obstack_finish (&dont_print_vb_obstack
);
860 for (i
= 0; i
< n_baseclasses
; i
++)
863 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
864 char *basename
= type_name_no_tag (baseclass
);
865 const gdb_byte
*base_valaddr
;
867 if (BASETYPE_VIA_VIRTUAL (type
, i
))
869 struct type
**first_dont_print
870 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
872 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
876 if (baseclass
== first_dont_print
[j
])
879 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
882 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
886 fprintf_filtered (stream
, "\n");
887 print_spaces_filtered (2 * recurse
, stream
);
889 fputs_filtered ("<", stream
);
890 /* Not sure what the best notation is in the case where there is no
893 fputs_filtered (basename
? basename
: "", stream
);
894 fputs_filtered ("> = ", stream
);
896 /* The virtual base class pointer might have been clobbered by the
897 user program. Make sure that it still points to a valid memory
900 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
902 /* FIXME (alloc): not safe is baseclass is really really big. */
903 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
906 if (target_read_memory (address
+ boffset
, buf
,
907 TYPE_LENGTH (baseclass
)) != 0)
911 base_valaddr
= valaddr
+ boffset
;
914 fprintf_filtered (stream
, "<invalid address>");
916 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
917 stream
, recurse
, options
,
918 (struct type
**) obstack_base (&dont_print_vb_obstack
),
920 fputs_filtered (", ", stream
);
926 if (dont_print_vb
== 0)
928 /* Free the space used to deal with the printing
929 of this type from top level. */
930 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
931 /* Reset watermark so that we can continue protecting
932 ourselves from whatever we were protecting ourselves. */
933 dont_print_vb_obstack
= tmp_obstack
;
937 /* Print value of a static member.
938 To avoid infinite recursion when printing a class that contains
939 a static instance of the class, we keep the addresses of all printed
940 static member classes in an obstack and refuse to print them more
943 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
944 have the same meanings as in c_val_print. */
947 pascal_object_print_static_field (struct value
*val
,
948 struct ui_file
*stream
,
950 const struct value_print_options
*options
)
952 struct type
*type
= value_type (val
);
953 struct value_print_options opts
;
955 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
957 CORE_ADDR
*first_dont_print
, addr
;
961 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
962 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
967 if (value_address (val
) == first_dont_print
[i
])
969 fputs_filtered ("<same as static member of an already seen type>",
975 addr
= value_address (val
);
976 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
979 CHECK_TYPEDEF (type
);
980 pascal_object_print_value_fields (type
, value_contents (val
), addr
,
981 stream
, recurse
, options
, NULL
, 1);
987 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
990 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
993 _initialize_pascal_valprint (void)
995 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
996 &user_print_options
.pascal_static_field_print
, _("\
997 Set printing of pascal static members."), _("\
998 Show printing of pascal static members."), NULL
,
1000 show_pascal_static_field_print
,
1001 &setprintlist
, &showprintlist
);