1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000, 2001, 2003, 2005 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* This file is derived from c-valprint.c */
25 #include "gdb_obstack.h"
28 #include "expression.h"
35 #include "typeprint.h"
41 #include "cp-support.h"
46 /* Print data of type TYPE located at VALADDR (within GDB), which came from
47 the inferior at address ADDRESS, onto stdio stream STREAM according to
48 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
51 If the data are a string pointer, returns the number of string characters
54 If DEREF_REF is nonzero, then dereference references, otherwise just print
57 The PRETTY parameter controls prettyprinting. */
61 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
62 int embedded_offset
, CORE_ADDR address
,
63 struct ui_file
*stream
, int format
, int deref_ref
,
64 int recurse
, enum val_prettyprint pretty
)
66 unsigned int i
= 0; /* Number of characters printed */
70 int length_pos
, length_size
, string_pos
;
76 switch (TYPE_CODE (type
))
79 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
81 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
82 eltlen
= TYPE_LENGTH (elttype
);
83 len
= TYPE_LENGTH (type
) / eltlen
;
84 if (prettyprint_arrays
)
86 print_spaces_filtered (2 + 2 * recurse
, stream
);
88 /* For an array of chars, print with string syntax. */
90 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
91 || ((current_language
->la_language
== language_m2
)
92 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
93 && (format
== 0 || format
== 's'))
95 /* If requested, look for the first null char and only print
97 if (stop_print_at_null
)
99 unsigned int temp_len
;
101 /* Look for a NULL char. */
103 (valaddr
+ embedded_offset
)[temp_len
]
104 && temp_len
< len
&& temp_len
< print_max
;
109 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 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 format
, deref_ref
, recurse
, pretty
, i
);
128 fprintf_filtered (stream
, "}");
132 /* Array of unspecified length: treat like pointer to first elt. */
134 goto print_unpacked_pointer
;
137 if (format
&& format
!= 's')
139 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
142 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
144 /* Print the unmangled name if desired. */
145 /* Print vtable entry - we only get here if we ARE using
146 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
147 /* Extract the address, assume that it is unsigned. */
148 print_address_demangle (extract_unsigned_integer (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
152 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
153 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
155 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
157 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
159 pascal_object_print_class_member (valaddr
+ embedded_offset
,
160 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
165 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
166 print_unpacked_pointer
:
167 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
169 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
171 /* Try to print what function it points to. */
172 print_address_demangle (addr
, stream
, demangle
);
173 /* Return value is irrelevant except for string pointers. */
177 if (addressprint
&& format
!= 's')
179 deprecated_print_address_numeric (addr
, 1, stream
);
182 /* For a pointer to char or unsigned char, also print the string
183 pointed to, unless pointer is null. */
184 if (TYPE_LENGTH (elttype
) == 1
185 && TYPE_CODE (elttype
) == TYPE_CODE_INT
186 && (format
== 0 || format
== 's')
189 /* no wide string yet */
190 i
= val_print_string (addr
, -1, 1, stream
);
192 /* also for pointers to pascal strings */
193 /* Note: this is Free Pascal specific:
194 as GDB does not recognize stabs pascal strings
195 Pascal strings are mapped to records
196 with lowercase names PM */
197 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
198 &string_pos
, &char_size
, NULL
)
201 ULONGEST string_length
;
203 buffer
= xmalloc (length_size
);
204 read_memory (addr
+ length_pos
, buffer
, length_size
);
205 string_length
= extract_unsigned_integer (buffer
, length_size
);
207 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
209 else if (pascal_object_is_vtbl_member (type
))
211 /* print vtbl's nicely */
212 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
214 struct minimal_symbol
*msymbol
=
215 lookup_minimal_symbol_by_pc (vt_address
);
216 if ((msymbol
!= NULL
)
217 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
219 fputs_filtered (" <", stream
);
220 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
221 fputs_filtered (">", stream
);
223 if (vt_address
&& vtblprint
)
225 struct value
*vt_val
;
226 struct symbol
*wsym
= (struct symbol
*) NULL
;
228 struct block
*block
= (struct block
*) NULL
;
232 wsym
= lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol
), block
,
233 VAR_DOMAIN
, &is_this_fld
, NULL
);
237 wtype
= SYMBOL_TYPE (wsym
);
241 wtype
= TYPE_TARGET_TYPE (type
);
243 vt_val
= value_at (wtype
, vt_address
);
244 common_val_print (vt_val
, stream
, format
, deref_ref
,
245 recurse
+ 1, pretty
);
248 fprintf_filtered (stream
, "\n");
249 print_spaces_filtered (2 + 2 * recurse
, stream
);
254 /* Return number of characters printed, including the terminating
255 '\0' if we reached the end. val_print_string takes care including
256 the terminating '\0' if necessary. */
261 case TYPE_CODE_MEMBER
:
262 error (_("not implemented: member type in pascal_val_print"));
266 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
267 if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
269 pascal_object_print_class_member (valaddr
+ embedded_offset
,
270 TYPE_DOMAIN_TYPE (elttype
),
276 fprintf_filtered (stream
, "@");
277 /* Extract the address, assume that it is unsigned. */
278 deprecated_print_address_numeric
279 (extract_unsigned_integer (valaddr
+ embedded_offset
,
280 TARGET_PTR_BIT
/ HOST_CHAR_BIT
),
283 fputs_filtered (": ", stream
);
285 /* De-reference the reference. */
288 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
290 struct value
*deref_val
=
292 (TYPE_TARGET_TYPE (type
),
293 unpack_pointer (lookup_pointer_type (builtin_type_void
),
294 valaddr
+ embedded_offset
));
295 common_val_print (deref_val
, stream
, format
, deref_ref
,
296 recurse
+ 1, pretty
);
299 fputs_filtered ("???", stream
);
303 case TYPE_CODE_UNION
:
304 if (recurse
&& !unionprint
)
306 fprintf_filtered (stream
, "{...}");
310 case TYPE_CODE_STRUCT
:
311 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
313 /* Print the unmangled name if desired. */
314 /* Print vtable entry - we only get here if NOT using
315 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
316 /* Extract the address, assume that it is unsigned. */
317 print_address_demangle
318 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
319 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
324 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
325 &string_pos
, &char_size
, NULL
))
327 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
328 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
331 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
332 recurse
, pretty
, NULL
, 0);
339 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
342 len
= TYPE_NFIELDS (type
);
343 val
= unpack_long (type
, valaddr
+ embedded_offset
);
344 for (i
= 0; i
< len
; i
++)
347 if (val
== TYPE_FIELD_BITPOS (type
, i
))
354 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
358 print_longest (stream
, 'd', 0, val
);
365 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
368 /* FIXME, we should consider, at least for ANSI C language, eliminating
369 the distinction made between FUNCs and POINTERs to FUNCs. */
370 fprintf_filtered (stream
, "{");
371 type_print (type
, "", stream
, -1);
372 fprintf_filtered (stream
, "} ");
373 /* Try to print what function it points to, and its address. */
374 print_address_demangle (address
, stream
, demangle
);
378 format
= format
? format
: output_format
;
380 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
383 val
= unpack_long (type
, valaddr
+ embedded_offset
);
385 fputs_filtered ("false", stream
);
387 fputs_filtered ("true", stream
);
390 fputs_filtered ("true (", stream
);
391 fprintf_filtered (stream
, "%ld)", (long int) val
);
396 case TYPE_CODE_RANGE
:
397 /* FIXME: create_range_type does not set the unsigned bit in a
398 range type (I think it probably should copy it from the target
399 type), so we won't print values which are too large to
400 fit in a signed integer correctly. */
401 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
402 print with the target type, though, because the size of our type
403 and the target type might differ). */
407 format
= format
? format
: output_format
;
410 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
414 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
419 format
= format
? format
: output_format
;
422 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
426 val
= unpack_long (type
, valaddr
+ embedded_offset
);
427 if (TYPE_UNSIGNED (type
))
428 fprintf_filtered (stream
, "%u", (unsigned int) val
);
430 fprintf_filtered (stream
, "%d", (int) val
);
431 fputs_filtered (" ", stream
);
432 LA_PRINT_CHAR ((unsigned char) val
, stream
);
439 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
443 print_floating (valaddr
+ embedded_offset
, type
, stream
);
447 case TYPE_CODE_BITSTRING
:
449 elttype
= TYPE_INDEX_TYPE (type
);
450 CHECK_TYPEDEF (elttype
);
451 if (TYPE_STUB (elttype
))
453 fprintf_filtered (stream
, "<incomplete type>");
459 struct type
*range
= elttype
;
460 LONGEST low_bound
, high_bound
;
462 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
466 fputs_filtered ("B'", stream
);
468 fputs_filtered ("[", stream
);
470 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
474 fputs_filtered ("<error value>", stream
);
478 for (i
= low_bound
; i
<= high_bound
; i
++)
480 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
484 goto maybe_bad_bstring
;
487 fprintf_filtered (stream
, "%d", element
);
491 fputs_filtered (", ", stream
);
492 print_type_scalar (range
, i
, stream
);
495 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
498 fputs_filtered ("..", stream
);
499 while (i
+ 1 <= high_bound
500 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
502 print_type_scalar (range
, j
, stream
);
508 fputs_filtered ("'", stream
);
510 fputs_filtered ("]", stream
);
515 fprintf_filtered (stream
, "void");
518 case TYPE_CODE_ERROR
:
519 fprintf_filtered (stream
, "<error type>");
522 case TYPE_CODE_UNDEF
:
523 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
524 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
525 and no complete type for struct foo in that file. */
526 fprintf_filtered (stream
, "<incomplete type>");
530 error (_("Invalid pascal type code %d in symbol table."), TYPE_CODE (type
));
537 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
538 enum val_prettyprint pretty
)
540 struct type
*type
= value_type (val
);
542 /* If it is a pointer, indicate what it points to.
544 Print type also if it is a reference.
546 Object pascal: if it is a member pointer, we will take care
547 of that when we print it. */
548 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
549 TYPE_CODE (type
) == TYPE_CODE_REF
)
551 /* Hack: remove (char *) for char strings. Their
552 type is indicated by the quoted string anyway. */
553 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
554 TYPE_NAME (type
) == NULL
&&
555 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
556 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
562 fprintf_filtered (stream
, "(");
563 type_print (type
, "", stream
, -1);
564 fprintf_filtered (stream
, ") ");
567 return common_val_print (val
, stream
, format
, 1, 0, pretty
);
571 /******************************************************************************
572 Inserted from cp-valprint
573 ******************************************************************************/
575 extern int vtblprint
; /* Controls printing of vtbl's */
576 extern int objectprint
; /* Controls looking up an object's derived type
577 using what we find in its vtables. */
578 static int pascal_static_field_print
; /* Controls printing of static fields. */
580 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
581 struct cmd_list_element
*c
, const char *value
)
583 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
587 static struct obstack dont_print_vb_obstack
;
588 static struct obstack dont_print_statmem_obstack
;
590 static void pascal_object_print_static_field (struct value
*,
591 struct ui_file
*, int, int,
592 enum val_prettyprint
);
594 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
595 CORE_ADDR
, struct ui_file
*,
596 int, int, enum val_prettyprint
,
600 pascal_object_print_class_method (const gdb_byte
*valaddr
, struct type
*type
,
601 struct ui_file
*stream
)
604 struct fn_field
*f
= NULL
;
613 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
615 domain
= TYPE_DOMAIN_TYPE (target_type
);
616 if (domain
== (struct type
*) NULL
)
618 fprintf_filtered (stream
, "<unknown>");
621 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
622 if (METHOD_PTR_IS_VIRTUAL (addr
))
624 offset
= METHOD_PTR_TO_VOFFSET (addr
);
625 len
= TYPE_NFN_FIELDS (domain
);
626 for (i
= 0; i
< len
; i
++)
628 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
629 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
631 check_stub_method_group (domain
, i
);
632 for (j
= 0; j
< len2
; j
++)
634 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
644 sym
= find_pc_function (addr
);
647 error (_("invalid pointer to member function"));
649 len
= TYPE_NFN_FIELDS (domain
);
650 for (i
= 0; i
< len
; i
++)
652 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
653 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
655 check_stub_method_group (domain
, i
);
656 for (j
= 0; j
< len2
; j
++)
658 if (DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
666 char *demangled_name
;
668 fprintf_filtered (stream
, "&");
669 fputs_filtered (kind
, stream
);
670 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
671 DMGL_ANSI
| DMGL_PARAMS
);
672 if (demangled_name
== NULL
)
673 fprintf_filtered (stream
, "<badly mangled name %s>",
674 TYPE_FN_FIELD_PHYSNAME (f
, j
));
677 fputs_filtered (demangled_name
, stream
);
678 xfree (demangled_name
);
683 fprintf_filtered (stream
, "(");
684 type_print (type
, "", stream
, -1);
685 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
689 /* It was changed to this after 2.4.5. */
690 const char pascal_vtbl_ptr_name
[] =
691 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
693 /* Return truth value for assertion that TYPE is of the type
694 "pointer to virtual function". */
697 pascal_object_is_vtbl_ptr_type (struct type
*type
)
699 char *typename
= type_name_no_tag (type
);
701 return (typename
!= NULL
702 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
705 /* Return truth value for the assertion that TYPE is of the type
706 "pointer to virtual function table". */
709 pascal_object_is_vtbl_member (struct type
*type
)
711 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
713 type
= TYPE_TARGET_TYPE (type
);
714 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
716 type
= TYPE_TARGET_TYPE (type
);
717 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
718 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
720 /* Virtual functions tables are full of pointers
721 to virtual functions. */
722 return pascal_object_is_vtbl_ptr_type (type
);
729 /* Mutually recursive subroutines of pascal_object_print_value and
730 c_val_print to print out a structure's fields:
731 pascal_object_print_value_fields and pascal_object_print_value.
733 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
734 same meanings as in pascal_object_print_value and c_val_print.
736 DONT_PRINT is an array of baseclass types that we
737 should not print, or zero if called from top level. */
740 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
741 CORE_ADDR address
, struct ui_file
*stream
,
742 int format
, int recurse
,
743 enum val_prettyprint pretty
,
744 struct type
**dont_print_vb
,
745 int dont_print_statmem
)
747 int i
, len
, n_baseclasses
;
748 struct obstack tmp_obstack
;
749 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
751 CHECK_TYPEDEF (type
);
753 fprintf_filtered (stream
, "{");
754 len
= TYPE_NFIELDS (type
);
755 n_baseclasses
= TYPE_N_BASECLASSES (type
);
757 /* Print out baseclasses such that we don't print
758 duplicates of virtual baseclasses. */
759 if (n_baseclasses
> 0)
760 pascal_object_print_value (type
, valaddr
, address
, stream
,
761 format
, recurse
+ 1, pretty
, dont_print_vb
);
763 if (!len
&& n_baseclasses
== 1)
764 fprintf_filtered (stream
, "<No data fields>");
769 if (dont_print_statmem
== 0)
771 /* If we're at top level, carve out a completely fresh
772 chunk of the obstack and use that until this particular
773 invocation returns. */
774 tmp_obstack
= dont_print_statmem_obstack
;
775 obstack_finish (&dont_print_statmem_obstack
);
778 for (i
= n_baseclasses
; i
< len
; i
++)
780 /* If requested, skip printing of static fields. */
781 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
784 fprintf_filtered (stream
, ", ");
785 else if (n_baseclasses
> 0)
789 fprintf_filtered (stream
, "\n");
790 print_spaces_filtered (2 + 2 * recurse
, stream
);
791 fputs_filtered ("members of ", stream
);
792 fputs_filtered (type_name_no_tag (type
), stream
);
793 fputs_filtered (": ", stream
);
800 fprintf_filtered (stream
, "\n");
801 print_spaces_filtered (2 + 2 * recurse
, stream
);
805 wrap_here (n_spaces (2 + 2 * recurse
));
809 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
810 fputs_filtered ("\"( ptr \"", stream
);
812 fputs_filtered ("\"( nodef \"", stream
);
813 if (TYPE_FIELD_STATIC (type
, i
))
814 fputs_filtered ("static ", stream
);
815 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
817 DMGL_PARAMS
| DMGL_ANSI
);
818 fputs_filtered ("\" \"", stream
);
819 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
821 DMGL_PARAMS
| DMGL_ANSI
);
822 fputs_filtered ("\") \"", stream
);
826 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
828 if (TYPE_FIELD_STATIC (type
, i
))
829 fputs_filtered ("static ", stream
);
830 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
832 DMGL_PARAMS
| DMGL_ANSI
);
833 annotate_field_name_end ();
834 fputs_filtered (" = ", stream
);
835 annotate_field_value ();
838 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
842 /* Bitfields require special handling, especially due to byte
844 if (TYPE_FIELD_IGNORE (type
, i
))
846 fputs_filtered ("<optimized out or zero length>", stream
);
850 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
851 unpack_field_as_long (type
, valaddr
, i
));
853 common_val_print (v
, stream
, format
, 0, recurse
+ 1, pretty
);
858 if (TYPE_FIELD_IGNORE (type
, i
))
860 fputs_filtered ("<optimized out or zero length>", stream
);
862 else if (TYPE_FIELD_STATIC (type
, i
))
864 /* struct value *v = value_static_field (type, i); v4.17 specific */
866 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
867 unpack_field_as_long (type
, valaddr
, i
));
870 fputs_filtered ("<optimized out>", stream
);
872 pascal_object_print_static_field (v
, stream
, format
,
873 recurse
+ 1, pretty
);
877 /* val_print (TYPE_FIELD_TYPE (type, i),
878 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
879 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
880 stream, format, 0, recurse + 1, pretty); */
881 val_print (TYPE_FIELD_TYPE (type
, i
),
882 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
883 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
884 stream
, format
, 0, recurse
+ 1, pretty
);
887 annotate_field_end ();
890 if (dont_print_statmem
== 0)
892 /* Free the space used to deal with the printing
893 of the members from top level. */
894 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
895 dont_print_statmem_obstack
= tmp_obstack
;
900 fprintf_filtered (stream
, "\n");
901 print_spaces_filtered (2 * recurse
, stream
);
904 fprintf_filtered (stream
, "}");
907 /* Special val_print routine to avoid printing multiple copies of virtual
911 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
912 CORE_ADDR address
, struct ui_file
*stream
,
913 int format
, int recurse
,
914 enum val_prettyprint pretty
,
915 struct type
**dont_print_vb
)
917 struct obstack tmp_obstack
;
918 struct type
**last_dont_print
919 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
920 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
922 if (dont_print_vb
== 0)
924 /* If we're at top level, carve out a completely fresh
925 chunk of the obstack and use that until this particular
926 invocation returns. */
927 tmp_obstack
= dont_print_vb_obstack
;
928 /* Bump up the high-water mark. Now alpha is omega. */
929 obstack_finish (&dont_print_vb_obstack
);
932 for (i
= 0; i
< n_baseclasses
; i
++)
935 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
936 char *basename
= TYPE_NAME (baseclass
);
937 const gdb_byte
*base_valaddr
;
939 if (BASETYPE_VIA_VIRTUAL (type
, i
))
941 struct type
**first_dont_print
942 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
944 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
948 if (baseclass
== first_dont_print
[j
])
951 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
954 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
958 fprintf_filtered (stream
, "\n");
959 print_spaces_filtered (2 * recurse
, stream
);
961 fputs_filtered ("<", stream
);
962 /* Not sure what the best notation is in the case where there is no
965 fputs_filtered (basename
? basename
: "", stream
);
966 fputs_filtered ("> = ", stream
);
968 /* The virtual base class pointer might have been clobbered by the
969 user program. Make sure that it still points to a valid memory
972 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
974 /* FIXME (alloc): not safe is baseclass is really really big. */
975 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
977 if (target_read_memory (address
+ boffset
, buf
,
978 TYPE_LENGTH (baseclass
)) != 0)
982 base_valaddr
= valaddr
+ boffset
;
985 fprintf_filtered (stream
, "<invalid address>");
987 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
988 stream
, format
, recurse
, pretty
,
989 (struct type
**) obstack_base (&dont_print_vb_obstack
),
991 fputs_filtered (", ", stream
);
997 if (dont_print_vb
== 0)
999 /* Free the space used to deal with the printing
1000 of this type from top level. */
1001 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
1002 /* Reset watermark so that we can continue protecting
1003 ourselves from whatever we were protecting ourselves. */
1004 dont_print_vb_obstack
= tmp_obstack
;
1008 /* Print value of a static member.
1009 To avoid infinite recursion when printing a class that contains
1010 a static instance of the class, we keep the addresses of all printed
1011 static member classes in an obstack and refuse to print them more
1014 VAL contains the value to print, STREAM, RECURSE, and PRETTY
1015 have the same meanings as in c_val_print. */
1018 pascal_object_print_static_field (struct value
*val
,
1019 struct ui_file
*stream
, int format
,
1020 int recurse
, enum val_prettyprint pretty
)
1022 struct type
*type
= value_type (val
);
1024 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1026 CORE_ADDR
*first_dont_print
;
1030 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1031 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1036 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1038 fputs_filtered ("<same as static member of an already seen type>",
1044 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1045 sizeof (CORE_ADDR
));
1047 CHECK_TYPEDEF (type
);
1048 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
1049 stream
, format
, recurse
, pretty
, NULL
, 1);
1052 common_val_print (val
, stream
, format
, 0, recurse
, pretty
);
1056 pascal_object_print_class_member (const gdb_byte
*valaddr
, struct type
*domain
,
1057 struct ui_file
*stream
, char *prefix
)
1060 /* VAL is a byte offset into the structure type DOMAIN.
1061 Find the name of the field for that offset and
1066 unsigned len
= TYPE_NFIELDS (domain
);
1067 /* @@ Make VAL into bit offset */
1068 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1069 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1071 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1075 if (val
< bitpos
&& i
!= 0)
1077 /* Somehow pointing into a field. */
1079 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1090 fputs_filtered (prefix
, stream
);
1091 name
= type_name_no_tag (domain
);
1093 fputs_filtered (name
, stream
);
1095 pascal_type_print_base (domain
, stream
, 0, 0);
1096 fprintf_filtered (stream
, "::");
1097 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1099 fprintf_filtered (stream
, " + %d bytes", extra
);
1101 fprintf_filtered (stream
, " (offset in bits)");
1104 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1107 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
1110 _initialize_pascal_valprint (void)
1112 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
1113 &pascal_static_field_print
, _("\
1114 Set printing of pascal static members."), _("\
1115 Show printing of pascal static members."), NULL
,
1117 show_pascal_static_field_print
,
1118 &setprintlist
, &showprintlist
);
1119 /* Turn on printing of static fields. */
1120 pascal_static_field_print
= 1;