1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005, 2006, 2007, 2008, 2009
4 Free Software Foundation, Inc.
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* This file is derived from c-valprint.c */
24 #include "gdb_obstack.h"
27 #include "expression.h"
34 #include "typeprint.h"
40 #include "cp-support.h"
45 /* Print data of type TYPE located at VALADDR (within GDB), which came from
46 the inferior at address ADDRESS, onto stdio stream STREAM according to
47 OPTIONS. The data at VALADDR is in target byte order.
49 If the data are a string pointer, returns the number of string characters
54 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
55 int embedded_offset
, CORE_ADDR address
,
56 struct ui_file
*stream
, int recurse
,
57 const struct value_print_options
*options
)
59 unsigned int i
= 0; /* Number of characters printed */
63 int length_pos
, length_size
, string_pos
;
64 struct type
*char_type
;
69 switch (TYPE_CODE (type
))
72 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
74 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
75 eltlen
= TYPE_LENGTH (elttype
);
76 len
= TYPE_LENGTH (type
) / eltlen
;
77 if (options
->prettyprint_arrays
)
79 print_spaces_filtered (2 + 2 * recurse
, stream
);
81 /* For an array of chars, print with string syntax. */
82 if ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
83 && ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
84 || ((current_language
->la_language
== language_pascal
)
85 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
86 && (options
->format
== 0 || options
->format
== 's'))
88 /* If requested, look for the first null char and only print
90 if (options
->stop_print_at_null
)
92 unsigned int temp_len
;
94 /* Look for a NULL char. */
96 extract_unsigned_integer (valaddr
+ embedded_offset
+
97 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
, 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
, address
, stream
,
123 recurse
, options
, i
);
124 fprintf_filtered (stream
, "}");
128 /* Array of unspecified length: treat like pointer to first elt. */
130 goto print_unpacked_pointer
;
133 if (options
->format
&& options
->format
!= 's')
135 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
139 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
141 /* Print the unmangled name if desired. */
142 /* Print vtable entry - we only get here if we ARE using
143 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
144 /* Extract the address, assume that it is unsigned. */
145 print_address_demangle (extract_unsigned_integer (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
149 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
151 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
152 print_unpacked_pointer
:
153 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
155 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
157 /* Try to print what function it points to. */
158 print_address_demangle (addr
, stream
, demangle
);
159 /* Return value is irrelevant except for string pointers. */
163 if (options
->addressprint
&& options
->format
!= 's')
165 fputs_filtered (paddress (addr
), stream
);
168 /* For a pointer to char or unsigned char, also print the string
169 pointed to, unless pointer is null. */
170 if (((TYPE_LENGTH (elttype
) == 1
171 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
172 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
173 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
174 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
175 && (options
->format
== 0 || options
->format
== 's')
178 /* no wide string yet */
179 i
= val_print_string (elttype
, addr
, -1, stream
, options
);
181 /* also for pointers to pascal strings */
182 /* Note: this is Free Pascal specific:
183 as GDB does not recognize stabs pascal strings
184 Pascal strings are mapped to records
185 with lowercase names PM */
186 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
187 &string_pos
, &char_type
, NULL
)
190 ULONGEST string_length
;
192 buffer
= xmalloc (length_size
);
193 read_memory (addr
+ length_pos
, buffer
, length_size
);
194 string_length
= extract_unsigned_integer (buffer
, length_size
);
196 i
= val_print_string (char_type
,addr
+ string_pos
, string_length
, stream
, options
);
198 else if (pascal_object_is_vtbl_member (type
))
200 /* print vtbl's nicely */
201 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
203 struct minimal_symbol
*msymbol
=
204 lookup_minimal_symbol_by_pc (vt_address
);
205 if ((msymbol
!= NULL
)
206 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
208 fputs_filtered (" <", stream
);
209 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
210 fputs_filtered (">", stream
);
212 if (vt_address
&& options
->vtblprint
)
214 struct value
*vt_val
;
215 struct symbol
*wsym
= (struct symbol
*) NULL
;
217 struct block
*block
= (struct block
*) NULL
;
221 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
222 VAR_DOMAIN
, &is_this_fld
);
226 wtype
= SYMBOL_TYPE (wsym
);
230 wtype
= TYPE_TARGET_TYPE (type
);
232 vt_val
= value_at (wtype
, vt_address
);
233 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
237 fprintf_filtered (stream
, "\n");
238 print_spaces_filtered (2 + 2 * recurse
, stream
);
243 /* Return number of characters printed, including the terminating
244 '\0' if we reached the end. val_print_string takes care including
245 the terminating '\0' if necessary. */
251 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
252 if (options
->addressprint
)
255 = extract_typed_address (valaddr
+ embedded_offset
, type
);
256 fprintf_filtered (stream
, "@");
257 fputs_filtered (paddress (addr
), stream
);
258 if (options
->deref_ref
)
259 fputs_filtered (": ", stream
);
261 /* De-reference the reference. */
262 if (options
->deref_ref
)
264 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
266 struct value
*deref_val
=
268 (TYPE_TARGET_TYPE (type
),
269 unpack_pointer (type
, valaddr
+ embedded_offset
));
270 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
274 fputs_filtered ("???", stream
);
278 case TYPE_CODE_UNION
:
279 if (recurse
&& !options
->unionprint
)
281 fprintf_filtered (stream
, "{...}");
285 case TYPE_CODE_STRUCT
:
286 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
288 /* Print the unmangled name if desired. */
289 /* Print vtable entry - we only get here if NOT using
290 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
291 /* Extract the address, assume that it is unsigned. */
292 print_address_demangle
293 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
294 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
299 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
300 &string_pos
, &char_type
, NULL
))
302 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
303 LA_PRINT_STRING (stream
, char_type
, valaddr
+ embedded_offset
+ string_pos
, len
, 0, options
);
306 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
307 recurse
, options
, NULL
, 0);
314 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
318 len
= TYPE_NFIELDS (type
);
319 val
= unpack_long (type
, valaddr
+ embedded_offset
);
320 for (i
= 0; i
< len
; i
++)
323 if (val
== TYPE_FIELD_BITPOS (type
, i
))
330 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
334 print_longest (stream
, 'd', 0, val
);
338 case TYPE_CODE_FLAGS
:
340 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
343 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
349 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
353 /* FIXME, we should consider, at least for ANSI C language, eliminating
354 the distinction made between FUNCs and POINTERs to FUNCs. */
355 fprintf_filtered (stream
, "{");
356 type_print (type
, "", stream
, -1);
357 fprintf_filtered (stream
, "} ");
358 /* Try to print what function it points to, and its address. */
359 print_address_demangle (address
, stream
, demangle
);
363 if (options
->format
|| options
->output_format
)
365 struct value_print_options opts
= *options
;
366 opts
.format
= (options
->format
? options
->format
367 : options
->output_format
);
368 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
373 val
= unpack_long (type
, valaddr
+ embedded_offset
);
375 fputs_filtered ("false", stream
);
377 fputs_filtered ("true", stream
);
380 fputs_filtered ("true (", stream
);
381 fprintf_filtered (stream
, "%ld)", (long int) val
);
386 case TYPE_CODE_RANGE
:
387 /* FIXME: create_range_type does not set the unsigned bit in a
388 range type (I think it probably should copy it from the target
389 type), so we won't print values which are too large to
390 fit in a signed integer correctly. */
391 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
392 print with the target type, though, because the size of our type
393 and the target type might differ). */
397 if (options
->format
|| options
->output_format
)
399 struct value_print_options opts
= *options
;
400 opts
.format
= (options
->format
? options
->format
401 : options
->output_format
);
402 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
407 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
412 if (options
->format
|| options
->output_format
)
414 struct value_print_options opts
= *options
;
415 opts
.format
= (options
->format
? options
->format
416 : options
->output_format
);
417 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
422 val
= unpack_long (type
, valaddr
+ embedded_offset
);
423 if (TYPE_UNSIGNED (type
))
424 fprintf_filtered (stream
, "%u", (unsigned int) val
);
426 fprintf_filtered (stream
, "%d", (int) val
);
427 fputs_filtered (" ", stream
);
428 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
435 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
440 print_floating (valaddr
+ embedded_offset
, type
, stream
);
444 case TYPE_CODE_BITSTRING
:
446 elttype
= TYPE_INDEX_TYPE (type
);
447 CHECK_TYPEDEF (elttype
);
448 if (TYPE_STUB (elttype
))
450 fprintf_filtered (stream
, "<incomplete type>");
456 struct type
*range
= elttype
;
457 LONGEST low_bound
, high_bound
;
459 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
463 fputs_filtered ("B'", stream
);
465 fputs_filtered ("[", stream
);
467 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
471 fputs_filtered ("<error value>", stream
);
475 for (i
= low_bound
; i
<= high_bound
; i
++)
477 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
481 goto maybe_bad_bstring
;
484 fprintf_filtered (stream
, "%d", element
);
488 fputs_filtered (", ", stream
);
489 print_type_scalar (range
, i
, stream
);
492 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
495 fputs_filtered ("..", stream
);
496 while (i
+ 1 <= high_bound
497 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
499 print_type_scalar (range
, j
, stream
);
505 fputs_filtered ("'", stream
);
507 fputs_filtered ("]", stream
);
512 fprintf_filtered (stream
, "void");
515 case TYPE_CODE_ERROR
:
516 fprintf_filtered (stream
, "<error type>");
519 case TYPE_CODE_UNDEF
:
520 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
521 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
522 and no complete type for struct foo in that file. */
523 fprintf_filtered (stream
, "<incomplete type>");
527 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
534 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
535 const struct value_print_options
*options
)
537 struct type
*type
= value_type (val
);
539 /* If it is a pointer, indicate what it points to.
541 Print type also if it is a reference.
543 Object pascal: if it is a member pointer, we will take care
544 of that when we print it. */
545 if (TYPE_CODE (type
) == TYPE_CODE_PTR
546 || TYPE_CODE (type
) == TYPE_CODE_REF
)
548 /* Hack: remove (char *) for char strings. Their
549 type is indicated by the quoted string anyway. */
550 if (TYPE_CODE (type
) == TYPE_CODE_PTR
551 && TYPE_NAME (type
) == NULL
552 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
553 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
559 fprintf_filtered (stream
, "(");
560 type_print (type
, "", stream
, -1);
561 fprintf_filtered (stream
, ") ");
564 return common_val_print (val
, stream
, 0, options
, current_language
);
569 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
570 struct cmd_list_element
*c
, const char *value
)
572 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
576 static struct obstack dont_print_vb_obstack
;
577 static struct obstack dont_print_statmem_obstack
;
579 static void pascal_object_print_static_field (struct value
*,
580 struct ui_file
*, int,
581 const struct value_print_options
*);
583 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
584 CORE_ADDR
, struct ui_file
*, int,
585 const struct value_print_options
*,
588 /* It was changed to this after 2.4.5. */
589 const char pascal_vtbl_ptr_name
[] =
590 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
592 /* Return truth value for assertion that TYPE is of the type
593 "pointer to virtual function". */
596 pascal_object_is_vtbl_ptr_type (struct type
*type
)
598 char *typename
= type_name_no_tag (type
);
600 return (typename
!= NULL
601 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
604 /* Return truth value for the assertion that TYPE is of the type
605 "pointer to virtual function table". */
608 pascal_object_is_vtbl_member (struct type
*type
)
610 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
612 type
= TYPE_TARGET_TYPE (type
);
613 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
615 type
= TYPE_TARGET_TYPE (type
);
616 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
617 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
619 /* Virtual functions tables are full of pointers
620 to virtual functions. */
621 return pascal_object_is_vtbl_ptr_type (type
);
628 /* Mutually recursive subroutines of pascal_object_print_value and
629 c_val_print to print out a structure's fields:
630 pascal_object_print_value_fields and pascal_object_print_value.
632 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
633 same meanings as in pascal_object_print_value and c_val_print.
635 DONT_PRINT is an array of baseclass types that we
636 should not print, or zero if called from top level. */
639 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
640 CORE_ADDR address
, struct ui_file
*stream
,
642 const struct value_print_options
*options
,
643 struct type
**dont_print_vb
,
644 int dont_print_statmem
)
646 int i
, len
, n_baseclasses
;
647 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
649 CHECK_TYPEDEF (type
);
651 fprintf_filtered (stream
, "{");
652 len
= TYPE_NFIELDS (type
);
653 n_baseclasses
= TYPE_N_BASECLASSES (type
);
655 /* Print out baseclasses such that we don't print
656 duplicates of virtual baseclasses. */
657 if (n_baseclasses
> 0)
658 pascal_object_print_value (type
, valaddr
, address
, stream
,
659 recurse
+ 1, options
, dont_print_vb
);
661 if (!len
&& n_baseclasses
== 1)
662 fprintf_filtered (stream
, "<No data fields>");
665 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
668 if (dont_print_statmem
== 0)
670 /* If we're at top level, carve out a completely fresh
671 chunk of the obstack and use that until this particular
672 invocation returns. */
673 obstack_finish (&dont_print_statmem_obstack
);
676 for (i
= n_baseclasses
; i
< len
; i
++)
678 /* If requested, skip printing of static fields. */
679 if (!options
->pascal_static_field_print
680 && field_is_static (&TYPE_FIELD (type
, i
)))
683 fprintf_filtered (stream
, ", ");
684 else if (n_baseclasses
> 0)
688 fprintf_filtered (stream
, "\n");
689 print_spaces_filtered (2 + 2 * recurse
, stream
);
690 fputs_filtered ("members of ", stream
);
691 fputs_filtered (type_name_no_tag (type
), stream
);
692 fputs_filtered (": ", stream
);
699 fprintf_filtered (stream
, "\n");
700 print_spaces_filtered (2 + 2 * recurse
, stream
);
704 wrap_here (n_spaces (2 + 2 * recurse
));
706 if (options
->inspect_it
)
708 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
709 fputs_filtered ("\"( ptr \"", stream
);
711 fputs_filtered ("\"( nodef \"", stream
);
712 if (field_is_static (&TYPE_FIELD (type
, i
)))
713 fputs_filtered ("static ", stream
);
714 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
716 DMGL_PARAMS
| DMGL_ANSI
);
717 fputs_filtered ("\" \"", stream
);
718 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
720 DMGL_PARAMS
| DMGL_ANSI
);
721 fputs_filtered ("\") \"", stream
);
725 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
727 if (field_is_static (&TYPE_FIELD (type
, i
)))
728 fputs_filtered ("static ", stream
);
729 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
731 DMGL_PARAMS
| DMGL_ANSI
);
732 annotate_field_name_end ();
733 fputs_filtered (" = ", stream
);
734 annotate_field_value ();
737 if (!field_is_static (&TYPE_FIELD (type
, i
))
738 && TYPE_FIELD_PACKED (type
, i
))
742 /* Bitfields require special handling, especially due to byte
744 if (TYPE_FIELD_IGNORE (type
, i
))
746 fputs_filtered ("<optimized out or zero length>", stream
);
750 struct value_print_options opts
= *options
;
751 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
752 unpack_field_as_long (type
, valaddr
, i
));
755 common_val_print (v
, stream
, recurse
+ 1, &opts
,
761 if (TYPE_FIELD_IGNORE (type
, i
))
763 fputs_filtered ("<optimized out or zero length>", stream
);
765 else if (field_is_static (&TYPE_FIELD (type
, i
)))
767 /* struct value *v = value_static_field (type, i); v4.17 specific */
769 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
770 unpack_field_as_long (type
, valaddr
, i
));
773 fputs_filtered ("<optimized out>", stream
);
775 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
780 struct value_print_options opts
= *options
;
782 /* val_print (TYPE_FIELD_TYPE (type, i),
783 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
784 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
785 stream, format, 0, recurse + 1, pretty); */
786 val_print (TYPE_FIELD_TYPE (type
, i
),
787 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
788 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
789 stream
, recurse
+ 1, &opts
,
793 annotate_field_end ();
796 if (dont_print_statmem
== 0)
798 /* Free the space used to deal with the printing
799 of the members from top level. */
800 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
801 dont_print_statmem_obstack
= tmp_obstack
;
806 fprintf_filtered (stream
, "\n");
807 print_spaces_filtered (2 * recurse
, stream
);
810 fprintf_filtered (stream
, "}");
813 /* Special val_print routine to avoid printing multiple copies of virtual
817 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
818 CORE_ADDR address
, struct ui_file
*stream
,
820 const struct value_print_options
*options
,
821 struct type
**dont_print_vb
)
823 struct type
**last_dont_print
824 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
825 struct obstack tmp_obstack
= dont_print_vb_obstack
;
826 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
828 if (dont_print_vb
== 0)
830 /* If we're at top level, carve out a completely fresh
831 chunk of the obstack and use that until this particular
832 invocation returns. */
833 /* Bump up the high-water mark. Now alpha is omega. */
834 obstack_finish (&dont_print_vb_obstack
);
837 for (i
= 0; i
< n_baseclasses
; i
++)
840 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
841 char *basename
= type_name_no_tag (baseclass
);
842 const gdb_byte
*base_valaddr
;
844 if (BASETYPE_VIA_VIRTUAL (type
, i
))
846 struct type
**first_dont_print
847 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
849 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
853 if (baseclass
== first_dont_print
[j
])
856 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
859 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
863 fprintf_filtered (stream
, "\n");
864 print_spaces_filtered (2 * recurse
, stream
);
866 fputs_filtered ("<", stream
);
867 /* Not sure what the best notation is in the case where there is no
870 fputs_filtered (basename
? basename
: "", stream
);
871 fputs_filtered ("> = ", stream
);
873 /* The virtual base class pointer might have been clobbered by the
874 user program. Make sure that it still points to a valid memory
877 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
879 /* FIXME (alloc): not safe is baseclass is really really big. */
880 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
882 if (target_read_memory (address
+ boffset
, buf
,
883 TYPE_LENGTH (baseclass
)) != 0)
887 base_valaddr
= valaddr
+ boffset
;
890 fprintf_filtered (stream
, "<invalid address>");
892 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
893 stream
, recurse
, options
,
894 (struct type
**) obstack_base (&dont_print_vb_obstack
),
896 fputs_filtered (", ", stream
);
902 if (dont_print_vb
== 0)
904 /* Free the space used to deal with the printing
905 of this type from top level. */
906 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
907 /* Reset watermark so that we can continue protecting
908 ourselves from whatever we were protecting ourselves. */
909 dont_print_vb_obstack
= tmp_obstack
;
913 /* Print value of a static member.
914 To avoid infinite recursion when printing a class that contains
915 a static instance of the class, we keep the addresses of all printed
916 static member classes in an obstack and refuse to print them more
919 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
920 have the same meanings as in c_val_print. */
923 pascal_object_print_static_field (struct value
*val
,
924 struct ui_file
*stream
,
926 const struct value_print_options
*options
)
928 struct type
*type
= value_type (val
);
929 struct value_print_options opts
;
931 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
933 CORE_ADDR
*first_dont_print
, addr
;
937 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
938 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
943 if (value_address (val
) == first_dont_print
[i
])
945 fputs_filtered ("<same as static member of an already seen type>",
951 addr
= value_address (val
);
952 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
955 CHECK_TYPEDEF (type
);
956 pascal_object_print_value_fields (type
, value_contents (val
), addr
,
957 stream
, recurse
, options
, NULL
, 1);
963 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
966 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
969 _initialize_pascal_valprint (void)
971 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
972 &user_print_options
.pascal_static_field_print
, _("\
973 Set printing of pascal static members."), _("\
974 Show printing of pascal static members."), NULL
,
976 show_pascal_static_field_print
,
977 &setprintlist
, &showprintlist
);