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
)
254 fprintf_filtered (stream
, "@");
255 /* Extract the address, assume that it is unsigned. */
256 fputs_filtered (paddress (
257 extract_unsigned_integer (valaddr
+ embedded_offset
,
258 gdbarch_ptr_bit (current_gdbarch
) / HOST_CHAR_BIT
)), stream
);
259 if (options
->deref_ref
)
260 fputs_filtered (": ", stream
);
262 /* De-reference the reference. */
263 if (options
->deref_ref
)
265 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
267 struct value
*deref_val
=
269 (TYPE_TARGET_TYPE (type
),
270 unpack_pointer (type
, valaddr
+ embedded_offset
));
271 common_val_print (deref_val
, stream
, recurse
+ 1, options
,
275 fputs_filtered ("???", stream
);
279 case TYPE_CODE_UNION
:
280 if (recurse
&& !options
->unionprint
)
282 fprintf_filtered (stream
, "{...}");
286 case TYPE_CODE_STRUCT
:
287 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
289 /* Print the unmangled name if desired. */
290 /* Print vtable entry - we only get here if NOT using
291 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
292 /* Extract the address, assume that it is unsigned. */
293 print_address_demangle
294 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
295 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
300 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
301 &string_pos
, &char_type
, NULL
))
303 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
304 LA_PRINT_STRING (stream
, char_type
, valaddr
+ embedded_offset
+ string_pos
, len
, 0, options
);
307 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
,
308 recurse
, options
, NULL
, 0);
315 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
319 len
= TYPE_NFIELDS (type
);
320 val
= unpack_long (type
, valaddr
+ embedded_offset
);
321 for (i
= 0; i
< len
; i
++)
324 if (val
== TYPE_FIELD_BITPOS (type
, i
))
331 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
335 print_longest (stream
, 'd', 0, val
);
339 case TYPE_CODE_FLAGS
:
341 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
344 val_print_type_code_flags (type
, valaddr
+ embedded_offset
, stream
);
350 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
354 /* FIXME, we should consider, at least for ANSI C language, eliminating
355 the distinction made between FUNCs and POINTERs to FUNCs. */
356 fprintf_filtered (stream
, "{");
357 type_print (type
, "", stream
, -1);
358 fprintf_filtered (stream
, "} ");
359 /* Try to print what function it points to, and its address. */
360 print_address_demangle (address
, stream
, demangle
);
364 if (options
->format
|| options
->output_format
)
366 struct value_print_options opts
= *options
;
367 opts
.format
= (options
->format
? options
->format
368 : options
->output_format
);
369 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
374 val
= unpack_long (type
, valaddr
+ embedded_offset
);
376 fputs_filtered ("false", stream
);
378 fputs_filtered ("true", stream
);
381 fputs_filtered ("true (", stream
);
382 fprintf_filtered (stream
, "%ld)", (long int) val
);
387 case TYPE_CODE_RANGE
:
388 /* FIXME: create_range_type does not set the unsigned bit in a
389 range type (I think it probably should copy it from the target
390 type), so we won't print values which are too large to
391 fit in a signed integer correctly. */
392 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
393 print with the target type, though, because the size of our type
394 and the target type might differ). */
398 if (options
->format
|| options
->output_format
)
400 struct value_print_options opts
= *options
;
401 opts
.format
= (options
->format
? options
->format
402 : options
->output_format
);
403 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
408 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
413 if (options
->format
|| options
->output_format
)
415 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
= unpack_long (type
, valaddr
+ embedded_offset
);
424 if (TYPE_UNSIGNED (type
))
425 fprintf_filtered (stream
, "%u", (unsigned int) val
);
427 fprintf_filtered (stream
, "%d", (int) val
);
428 fputs_filtered (" ", stream
);
429 LA_PRINT_CHAR ((unsigned char) val
, type
, stream
);
436 print_scalar_formatted (valaddr
+ embedded_offset
, type
,
441 print_floating (valaddr
+ embedded_offset
, type
, stream
);
445 case TYPE_CODE_BITSTRING
:
447 elttype
= TYPE_INDEX_TYPE (type
);
448 CHECK_TYPEDEF (elttype
);
449 if (TYPE_STUB (elttype
))
451 fprintf_filtered (stream
, "<incomplete type>");
457 struct type
*range
= elttype
;
458 LONGEST low_bound
, high_bound
;
460 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
464 fputs_filtered ("B'", stream
);
466 fputs_filtered ("[", stream
);
468 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
472 fputs_filtered ("<error value>", stream
);
476 for (i
= low_bound
; i
<= high_bound
; i
++)
478 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
482 goto maybe_bad_bstring
;
485 fprintf_filtered (stream
, "%d", element
);
489 fputs_filtered (", ", stream
);
490 print_type_scalar (range
, i
, stream
);
493 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
496 fputs_filtered ("..", stream
);
497 while (i
+ 1 <= high_bound
498 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
500 print_type_scalar (range
, j
, stream
);
506 fputs_filtered ("'", stream
);
508 fputs_filtered ("]", stream
);
513 fprintf_filtered (stream
, "void");
516 case TYPE_CODE_ERROR
:
517 fprintf_filtered (stream
, "<error type>");
520 case TYPE_CODE_UNDEF
:
521 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
522 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
523 and no complete type for struct foo in that file. */
524 fprintf_filtered (stream
, "<incomplete type>");
528 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
535 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
536 const struct value_print_options
*options
)
538 struct type
*type
= value_type (val
);
540 /* If it is a pointer, indicate what it points to.
542 Print type also if it is a reference.
544 Object pascal: if it is a member pointer, we will take care
545 of that when we print it. */
546 if (TYPE_CODE (type
) == TYPE_CODE_PTR
547 || TYPE_CODE (type
) == TYPE_CODE_REF
)
549 /* Hack: remove (char *) for char strings. Their
550 type is indicated by the quoted string anyway. */
551 if (TYPE_CODE (type
) == TYPE_CODE_PTR
552 && TYPE_NAME (type
) == NULL
553 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
554 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
560 fprintf_filtered (stream
, "(");
561 type_print (type
, "", stream
, -1);
562 fprintf_filtered (stream
, ") ");
565 return common_val_print (val
, stream
, 0, options
, current_language
);
570 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
571 struct cmd_list_element
*c
, const char *value
)
573 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
577 static struct obstack dont_print_vb_obstack
;
578 static struct obstack dont_print_statmem_obstack
;
580 static void pascal_object_print_static_field (struct value
*,
581 struct ui_file
*, int,
582 const struct value_print_options
*);
584 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
585 CORE_ADDR
, struct ui_file
*, int,
586 const struct value_print_options
*,
589 /* It was changed to this after 2.4.5. */
590 const char pascal_vtbl_ptr_name
[] =
591 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
593 /* Return truth value for assertion that TYPE is of the type
594 "pointer to virtual function". */
597 pascal_object_is_vtbl_ptr_type (struct type
*type
)
599 char *typename
= type_name_no_tag (type
);
601 return (typename
!= NULL
602 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
605 /* Return truth value for the assertion that TYPE is of the type
606 "pointer to virtual function table". */
609 pascal_object_is_vtbl_member (struct type
*type
)
611 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
613 type
= TYPE_TARGET_TYPE (type
);
614 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
616 type
= TYPE_TARGET_TYPE (type
);
617 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
618 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
620 /* Virtual functions tables are full of pointers
621 to virtual functions. */
622 return pascal_object_is_vtbl_ptr_type (type
);
629 /* Mutually recursive subroutines of pascal_object_print_value and
630 c_val_print to print out a structure's fields:
631 pascal_object_print_value_fields and pascal_object_print_value.
633 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
634 same meanings as in pascal_object_print_value and c_val_print.
636 DONT_PRINT is an array of baseclass types that we
637 should not print, or zero if called from top level. */
640 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
641 CORE_ADDR address
, struct ui_file
*stream
,
643 const struct value_print_options
*options
,
644 struct type
**dont_print_vb
,
645 int dont_print_statmem
)
647 int i
, len
, n_baseclasses
;
648 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
650 CHECK_TYPEDEF (type
);
652 fprintf_filtered (stream
, "{");
653 len
= TYPE_NFIELDS (type
);
654 n_baseclasses
= TYPE_N_BASECLASSES (type
);
656 /* Print out baseclasses such that we don't print
657 duplicates of virtual baseclasses. */
658 if (n_baseclasses
> 0)
659 pascal_object_print_value (type
, valaddr
, address
, stream
,
660 recurse
+ 1, options
, dont_print_vb
);
662 if (!len
&& n_baseclasses
== 1)
663 fprintf_filtered (stream
, "<No data fields>");
666 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
669 if (dont_print_statmem
== 0)
671 /* If we're at top level, carve out a completely fresh
672 chunk of the obstack and use that until this particular
673 invocation returns. */
674 obstack_finish (&dont_print_statmem_obstack
);
677 for (i
= n_baseclasses
; i
< len
; i
++)
679 /* If requested, skip printing of static fields. */
680 if (!options
->pascal_static_field_print
681 && field_is_static (&TYPE_FIELD (type
, i
)))
684 fprintf_filtered (stream
, ", ");
685 else if (n_baseclasses
> 0)
689 fprintf_filtered (stream
, "\n");
690 print_spaces_filtered (2 + 2 * recurse
, stream
);
691 fputs_filtered ("members of ", stream
);
692 fputs_filtered (type_name_no_tag (type
), stream
);
693 fputs_filtered (": ", stream
);
700 fprintf_filtered (stream
, "\n");
701 print_spaces_filtered (2 + 2 * recurse
, stream
);
705 wrap_here (n_spaces (2 + 2 * recurse
));
707 if (options
->inspect_it
)
709 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
710 fputs_filtered ("\"( ptr \"", stream
);
712 fputs_filtered ("\"( nodef \"", stream
);
713 if (field_is_static (&TYPE_FIELD (type
, i
)))
714 fputs_filtered ("static ", stream
);
715 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
717 DMGL_PARAMS
| DMGL_ANSI
);
718 fputs_filtered ("\" \"", stream
);
719 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
721 DMGL_PARAMS
| DMGL_ANSI
);
722 fputs_filtered ("\") \"", stream
);
726 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
728 if (field_is_static (&TYPE_FIELD (type
, i
)))
729 fputs_filtered ("static ", stream
);
730 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
732 DMGL_PARAMS
| DMGL_ANSI
);
733 annotate_field_name_end ();
734 fputs_filtered (" = ", stream
);
735 annotate_field_value ();
738 if (!field_is_static (&TYPE_FIELD (type
, i
))
739 && TYPE_FIELD_PACKED (type
, i
))
743 /* Bitfields require special handling, especially due to byte
745 if (TYPE_FIELD_IGNORE (type
, i
))
747 fputs_filtered ("<optimized out or zero length>", stream
);
751 struct value_print_options opts
= *options
;
752 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
753 unpack_field_as_long (type
, valaddr
, i
));
756 common_val_print (v
, stream
, recurse
+ 1, &opts
,
762 if (TYPE_FIELD_IGNORE (type
, i
))
764 fputs_filtered ("<optimized out or zero length>", stream
);
766 else if (field_is_static (&TYPE_FIELD (type
, i
)))
768 /* struct value *v = value_static_field (type, i); v4.17 specific */
770 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
771 unpack_field_as_long (type
, valaddr
, i
));
774 fputs_filtered ("<optimized out>", stream
);
776 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
781 struct value_print_options opts
= *options
;
783 /* val_print (TYPE_FIELD_TYPE (type, i),
784 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
785 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
786 stream, format, 0, recurse + 1, pretty); */
787 val_print (TYPE_FIELD_TYPE (type
, i
),
788 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
789 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
790 stream
, recurse
+ 1, &opts
,
794 annotate_field_end ();
797 if (dont_print_statmem
== 0)
799 /* Free the space used to deal with the printing
800 of the members from top level. */
801 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
802 dont_print_statmem_obstack
= tmp_obstack
;
807 fprintf_filtered (stream
, "\n");
808 print_spaces_filtered (2 * recurse
, stream
);
811 fprintf_filtered (stream
, "}");
814 /* Special val_print routine to avoid printing multiple copies of virtual
818 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
819 CORE_ADDR address
, struct ui_file
*stream
,
821 const struct value_print_options
*options
,
822 struct type
**dont_print_vb
)
824 struct type
**last_dont_print
825 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
826 struct obstack tmp_obstack
= dont_print_vb_obstack
;
827 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
829 if (dont_print_vb
== 0)
831 /* If we're at top level, carve out a completely fresh
832 chunk of the obstack and use that until this particular
833 invocation returns. */
834 /* Bump up the high-water mark. Now alpha is omega. */
835 obstack_finish (&dont_print_vb_obstack
);
838 for (i
= 0; i
< n_baseclasses
; i
++)
841 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
842 char *basename
= type_name_no_tag (baseclass
);
843 const gdb_byte
*base_valaddr
;
845 if (BASETYPE_VIA_VIRTUAL (type
, i
))
847 struct type
**first_dont_print
848 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
850 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
854 if (baseclass
== first_dont_print
[j
])
857 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
860 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
864 fprintf_filtered (stream
, "\n");
865 print_spaces_filtered (2 * recurse
, stream
);
867 fputs_filtered ("<", stream
);
868 /* Not sure what the best notation is in the case where there is no
871 fputs_filtered (basename
? basename
: "", stream
);
872 fputs_filtered ("> = ", stream
);
874 /* The virtual base class pointer might have been clobbered by the
875 user program. Make sure that it still points to a valid memory
878 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
880 /* FIXME (alloc): not safe is baseclass is really really big. */
881 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
883 if (target_read_memory (address
+ boffset
, buf
,
884 TYPE_LENGTH (baseclass
)) != 0)
888 base_valaddr
= valaddr
+ boffset
;
891 fprintf_filtered (stream
, "<invalid address>");
893 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
894 stream
, recurse
, options
,
895 (struct type
**) obstack_base (&dont_print_vb_obstack
),
897 fputs_filtered (", ", stream
);
903 if (dont_print_vb
== 0)
905 /* Free the space used to deal with the printing
906 of this type from top level. */
907 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
908 /* Reset watermark so that we can continue protecting
909 ourselves from whatever we were protecting ourselves. */
910 dont_print_vb_obstack
= tmp_obstack
;
914 /* Print value of a static member.
915 To avoid infinite recursion when printing a class that contains
916 a static instance of the class, we keep the addresses of all printed
917 static member classes in an obstack and refuse to print them more
920 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
921 have the same meanings as in c_val_print. */
924 pascal_object_print_static_field (struct value
*val
,
925 struct ui_file
*stream
,
927 const struct value_print_options
*options
)
929 struct type
*type
= value_type (val
);
930 struct value_print_options opts
;
932 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
934 CORE_ADDR
*first_dont_print
;
938 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
939 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
944 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
946 fputs_filtered ("<same as static member of an already seen type>",
952 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
955 CHECK_TYPEDEF (type
);
956 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
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
);