1 /* Support for printing Pascal values for GDB, the GNU debugger.
2 Copyright 2000, 2001, 2003
3 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
21 /* This file is derived from c-valprint.c */
24 #include "gdb_obstack.h"
27 #include "expression.h"
34 #include "typeprint.h"
44 /* Print data of type TYPE located at VALADDR (within GDB), which came from
45 the inferior at address ADDRESS, onto stdio stream STREAM according to
46 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
49 If the data are a string pointer, returns the number of string characters
52 If DEREF_REF is nonzero, then dereference references, otherwise just print
55 The PRETTY parameter controls prettyprinting. */
59 pascal_val_print (struct type
*type
, char *valaddr
, int embedded_offset
,
60 CORE_ADDR address
, struct ui_file
*stream
, int format
,
61 int deref_ref
, int recurse
, enum val_prettyprint pretty
)
63 register unsigned int i
= 0; /* Number of characters printed */
67 int length_pos
, length_size
, string_pos
;
73 switch (TYPE_CODE (type
))
76 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
78 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
79 eltlen
= TYPE_LENGTH (elttype
);
80 len
= TYPE_LENGTH (type
) / eltlen
;
81 if (prettyprint_arrays
)
83 print_spaces_filtered (2 + 2 * recurse
, stream
);
85 /* For an array of chars, print with string syntax. */
87 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
88 || ((current_language
->la_language
== language_m2
)
89 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
90 && (format
== 0 || format
== 's'))
92 /* If requested, look for the first null char and only print
94 if (stop_print_at_null
)
96 unsigned int temp_len
;
98 /* Look for a NULL char. */
100 (valaddr
+ embedded_offset
)[temp_len
]
101 && temp_len
< len
&& temp_len
< print_max
;
106 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
111 fprintf_filtered (stream
, "{");
112 /* If this is a virtual function table, print the 0th
113 entry specially, and the rest of the members normally. */
114 if (pascal_object_is_vtbl_ptr_type (elttype
))
117 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
123 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
124 format
, deref_ref
, recurse
, pretty
, i
);
125 fprintf_filtered (stream
, "}");
129 /* Array of unspecified length: treat like pointer to first elt. */
131 goto print_unpacked_pointer
;
134 if (format
&& format
!= 's')
136 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
139 if (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 print_address_demangle (extract_address (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
148 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
149 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
151 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
153 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
155 pascal_object_print_class_member (valaddr
+ embedded_offset
,
156 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
161 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
162 print_unpacked_pointer
:
163 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
165 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
167 /* Try to print what function it points to. */
168 print_address_demangle (addr
, stream
, demangle
);
169 /* Return value is irrelevant except for string pointers. */
173 if (addressprint
&& format
!= 's')
175 print_address_numeric (addr
, 1, stream
);
178 /* For a pointer to char or unsigned char, also print the string
179 pointed to, unless pointer is null. */
180 if (TYPE_LENGTH (elttype
) == 1
181 && TYPE_CODE (elttype
) == TYPE_CODE_INT
182 && (format
== 0 || format
== 's')
185 /* no wide string yet */
186 i
= val_print_string (addr
, -1, 1, stream
);
188 /* also for pointers to pascal strings */
189 /* Note: this is Free Pascal specific:
190 as GDB does not recognize stabs pascal strings
191 Pascal strings are mapped to records
192 with lowercase names PM */
193 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
194 &string_pos
, &char_size
, NULL
)
197 ULONGEST string_length
;
199 buffer
= xmalloc (length_size
);
200 read_memory (addr
+ length_pos
, buffer
, length_size
);
201 string_length
= extract_unsigned_integer (buffer
, length_size
);
203 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
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
);
210 struct minimal_symbol
*msymbol
=
211 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
&& vtblprint
)
221 struct value
*vt_val
;
222 struct symbol
*wsym
= (struct symbol
*) NULL
;
225 struct block
*block
= (struct block
*) NULL
;
229 wsym
= lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol
), block
,
230 VAR_DOMAIN
, &is_this_fld
, &s
);
234 wtype
= SYMBOL_TYPE (wsym
);
238 wtype
= TYPE_TARGET_TYPE (type
);
240 vt_val
= value_at (wtype
, vt_address
, NULL
);
241 val_print (VALUE_TYPE (vt_val
), VALUE_CONTENTS (vt_val
), 0,
242 VALUE_ADDRESS (vt_val
), stream
, format
,
243 deref_ref
, recurse
+ 1, pretty
);
246 fprintf_filtered (stream
, "\n");
247 print_spaces_filtered (2 + 2 * recurse
, stream
);
252 /* Return number of characters printed, including the terminating
253 '\0' if we reached the end. val_print_string takes care including
254 the terminating '\0' if necessary. */
259 case TYPE_CODE_MEMBER
:
260 error ("not implemented: member type in pascal_val_print");
264 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
265 if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
267 pascal_object_print_class_member (valaddr
+ embedded_offset
,
268 TYPE_DOMAIN_TYPE (elttype
),
274 fprintf_filtered (stream
, "@");
275 print_address_numeric
276 (extract_address (valaddr
+ embedded_offset
,
277 TARGET_PTR_BIT
/ HOST_CHAR_BIT
), 1, stream
);
279 fputs_filtered (": ", stream
);
281 /* De-reference the reference. */
284 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
286 struct value
*deref_val
=
288 (TYPE_TARGET_TYPE (type
),
289 unpack_pointer (lookup_pointer_type (builtin_type_void
),
290 valaddr
+ embedded_offset
),
292 val_print (VALUE_TYPE (deref_val
),
293 VALUE_CONTENTS (deref_val
), 0,
294 VALUE_ADDRESS (deref_val
), stream
, format
,
295 deref_ref
, recurse
+ 1, pretty
);
298 fputs_filtered ("???", stream
);
302 case TYPE_CODE_UNION
:
303 if (recurse
&& !unionprint
)
305 fprintf_filtered (stream
, "{...}");
309 case TYPE_CODE_STRUCT
:
310 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
312 /* Print the unmangled name if desired. */
313 /* Print vtable entry - we only get here if NOT using
314 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
315 print_address_demangle (extract_address (
316 valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
317 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
322 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
323 &string_pos
, &char_size
, NULL
))
325 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
326 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
329 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
330 recurse
, pretty
, NULL
, 0);
337 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
340 len
= TYPE_NFIELDS (type
);
341 val
= unpack_long (type
, valaddr
+ embedded_offset
);
342 for (i
= 0; i
< len
; i
++)
345 if (val
== TYPE_FIELD_BITPOS (type
, i
))
352 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
356 print_longest (stream
, 'd', 0, val
);
363 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
366 /* FIXME, we should consider, at least for ANSI C language, eliminating
367 the distinction made between FUNCs and POINTERs to FUNCs. */
368 fprintf_filtered (stream
, "{");
369 type_print (type
, "", stream
, -1);
370 fprintf_filtered (stream
, "} ");
371 /* Try to print what function it points to, and its address. */
372 print_address_demangle (address
, stream
, demangle
);
376 format
= format
? format
: output_format
;
378 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
381 val
= unpack_long (type
, valaddr
+ embedded_offset
);
383 fputs_filtered ("false", stream
);
385 fputs_filtered ("true", stream
);
388 fputs_filtered ("true (", stream
);
389 fprintf_filtered (stream
, "%ld)", (long int) val
);
394 case TYPE_CODE_RANGE
:
395 /* FIXME: create_range_type does not set the unsigned bit in a
396 range type (I think it probably should copy it from the target
397 type), so we won't print values which are too large to
398 fit in a signed integer correctly. */
399 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
400 print with the target type, though, because the size of our type
401 and the target type might differ). */
405 format
= format
? format
: output_format
;
408 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
412 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
417 format
= format
? format
: output_format
;
420 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
424 val
= unpack_long (type
, valaddr
+ embedded_offset
);
425 if (TYPE_UNSIGNED (type
))
426 fprintf_filtered (stream
, "%u", (unsigned int) val
);
428 fprintf_filtered (stream
, "%d", (int) val
);
429 fputs_filtered (" ", stream
);
430 LA_PRINT_CHAR ((unsigned char) val
, stream
);
437 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
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
, int format
,
536 enum val_prettyprint pretty
)
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 STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char"))
560 fprintf_filtered (stream
, "(");
561 type_print (type
, "", stream
, -1);
562 fprintf_filtered (stream
, ") ");
565 return val_print (type
, VALUE_CONTENTS (val
), VALUE_EMBEDDED_OFFSET (val
),
566 VALUE_ADDRESS (val
) + VALUE_OFFSET (val
),
567 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 static struct obstack dont_print_vb_obstack
;
581 static struct obstack dont_print_statmem_obstack
;
583 static void pascal_object_print_static_field (struct type
*, struct value
*,
584 struct ui_file
*, int, int,
585 enum val_prettyprint
);
588 pascal_object_print_value (struct type
*, char *, CORE_ADDR
, struct ui_file
*,
589 int, int, enum val_prettyprint
, struct type
**);
592 pascal_object_print_class_method (char *valaddr
, struct type
*type
,
593 struct ui_file
*stream
)
596 struct fn_field
*f
= NULL
;
605 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
607 domain
= TYPE_DOMAIN_TYPE (target_type
);
608 if (domain
== (struct type
*) NULL
)
610 fprintf_filtered (stream
, "<unknown>");
613 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
614 if (METHOD_PTR_IS_VIRTUAL (addr
))
616 offset
= METHOD_PTR_TO_VOFFSET (addr
);
617 len
= TYPE_NFN_FIELDS (domain
);
618 for (i
= 0; i
< len
; i
++)
620 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
621 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
623 check_stub_method_group (domain
, i
);
624 for (j
= 0; j
< len2
; j
++)
626 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
636 sym
= find_pc_function (addr
);
639 error ("invalid pointer to member function");
641 len
= TYPE_NFN_FIELDS (domain
);
642 for (i
= 0; i
< len
; i
++)
644 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
645 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
647 check_stub_method_group (domain
, i
);
648 for (j
= 0; j
< len2
; j
++)
650 if (STREQ (DEPRECATED_SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
658 char *demangled_name
;
660 fprintf_filtered (stream
, "&");
661 fprintf_filtered (stream
, kind
);
662 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
663 DMGL_ANSI
| DMGL_PARAMS
);
664 if (demangled_name
== NULL
)
665 fprintf_filtered (stream
, "<badly mangled name %s>",
666 TYPE_FN_FIELD_PHYSNAME (f
, j
));
669 fputs_filtered (demangled_name
, stream
);
670 xfree (demangled_name
);
675 fprintf_filtered (stream
, "(");
676 type_print (type
, "", stream
, -1);
677 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
681 /* It was changed to this after 2.4.5. */
682 const char pascal_vtbl_ptr_name
[] =
683 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
685 /* Return truth value for assertion that TYPE is of the type
686 "pointer to virtual function". */
689 pascal_object_is_vtbl_ptr_type (struct type
*type
)
691 char *typename
= type_name_no_tag (type
);
693 return (typename
!= NULL
694 && (STREQ (typename
, pascal_vtbl_ptr_name
)));
697 /* Return truth value for the assertion that TYPE is of the type
698 "pointer to virtual function table". */
701 pascal_object_is_vtbl_member (struct type
*type
)
703 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
705 type
= TYPE_TARGET_TYPE (type
);
706 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
708 type
= TYPE_TARGET_TYPE (type
);
709 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
710 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
712 /* Virtual functions tables are full of pointers
713 to virtual functions. */
714 return pascal_object_is_vtbl_ptr_type (type
);
721 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
722 print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
724 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
725 same meanings as in pascal_object_print_value and c_val_print.
727 DONT_PRINT is an array of baseclass types that we
728 should not print, or zero if called from top level. */
731 pascal_object_print_value_fields (struct type
*type
, char *valaddr
,
732 CORE_ADDR address
, struct ui_file
*stream
,
733 int format
, int recurse
,
734 enum val_prettyprint pretty
,
735 struct type
**dont_print_vb
,
736 int dont_print_statmem
)
738 int i
, len
, n_baseclasses
;
739 struct obstack tmp_obstack
;
740 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
742 CHECK_TYPEDEF (type
);
744 fprintf_filtered (stream
, "{");
745 len
= TYPE_NFIELDS (type
);
746 n_baseclasses
= TYPE_N_BASECLASSES (type
);
748 /* Print out baseclasses such that we don't print
749 duplicates of virtual baseclasses. */
750 if (n_baseclasses
> 0)
751 pascal_object_print_value (type
, valaddr
, address
, stream
,
752 format
, recurse
+ 1, pretty
, dont_print_vb
);
754 if (!len
&& n_baseclasses
== 1)
755 fprintf_filtered (stream
, "<No data fields>");
760 if (dont_print_statmem
== 0)
762 /* If we're at top level, carve out a completely fresh
763 chunk of the obstack and use that until this particular
764 invocation returns. */
765 tmp_obstack
= dont_print_statmem_obstack
;
766 obstack_finish (&dont_print_statmem_obstack
);
769 for (i
= n_baseclasses
; i
< len
; i
++)
771 /* If requested, skip printing of static fields. */
772 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
775 fprintf_filtered (stream
, ", ");
776 else if (n_baseclasses
> 0)
780 fprintf_filtered (stream
, "\n");
781 print_spaces_filtered (2 + 2 * recurse
, stream
);
782 fputs_filtered ("members of ", stream
);
783 fputs_filtered (type_name_no_tag (type
), stream
);
784 fputs_filtered (": ", stream
);
791 fprintf_filtered (stream
, "\n");
792 print_spaces_filtered (2 + 2 * recurse
, stream
);
796 wrap_here (n_spaces (2 + 2 * recurse
));
800 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
801 fputs_filtered ("\"( ptr \"", stream
);
803 fputs_filtered ("\"( nodef \"", stream
);
804 if (TYPE_FIELD_STATIC (type
, i
))
805 fputs_filtered ("static ", stream
);
806 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
808 DMGL_PARAMS
| DMGL_ANSI
);
809 fputs_filtered ("\" \"", stream
);
810 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
812 DMGL_PARAMS
| DMGL_ANSI
);
813 fputs_filtered ("\") \"", stream
);
817 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
819 if (TYPE_FIELD_STATIC (type
, i
))
820 fputs_filtered ("static ", stream
);
821 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
823 DMGL_PARAMS
| DMGL_ANSI
);
824 annotate_field_name_end ();
825 fputs_filtered (" = ", stream
);
826 annotate_field_value ();
829 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
833 /* Bitfields require special handling, especially due to byte
835 if (TYPE_FIELD_IGNORE (type
, i
))
837 fputs_filtered ("<optimized out or zero length>", stream
);
841 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
842 unpack_field_as_long (type
, valaddr
, i
));
844 val_print (TYPE_FIELD_TYPE (type
, i
), VALUE_CONTENTS (v
), 0, 0,
845 stream
, format
, 0, recurse
+ 1, pretty
);
850 if (TYPE_FIELD_IGNORE (type
, i
))
852 fputs_filtered ("<optimized out or zero length>", stream
);
854 else if (TYPE_FIELD_STATIC (type
, i
))
856 /* struct value *v = value_static_field (type, i); v4.17 specific */
858 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
859 unpack_field_as_long (type
, valaddr
, i
));
862 fputs_filtered ("<optimized out>", stream
);
864 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
865 stream
, format
, recurse
+ 1,
870 /* val_print (TYPE_FIELD_TYPE (type, i),
871 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
872 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
873 stream, format, 0, recurse + 1, pretty); */
874 val_print (TYPE_FIELD_TYPE (type
, i
),
875 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
876 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
877 stream
, format
, 0, recurse
+ 1, pretty
);
880 annotate_field_end ();
883 if (dont_print_statmem
== 0)
885 /* Free the space used to deal with the printing
886 of the members from top level. */
887 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
888 dont_print_statmem_obstack
= tmp_obstack
;
893 fprintf_filtered (stream
, "\n");
894 print_spaces_filtered (2 * recurse
, stream
);
897 fprintf_filtered (stream
, "}");
900 /* Special val_print routine to avoid printing multiple copies of virtual
904 pascal_object_print_value (struct type
*type
, char *valaddr
, CORE_ADDR address
,
905 struct ui_file
*stream
, int format
, int recurse
,
906 enum val_prettyprint pretty
,
907 struct type
**dont_print_vb
)
909 struct obstack tmp_obstack
;
910 struct type
**last_dont_print
911 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
912 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
914 if (dont_print_vb
== 0)
916 /* If we're at top level, carve out a completely fresh
917 chunk of the obstack and use that until this particular
918 invocation returns. */
919 tmp_obstack
= dont_print_vb_obstack
;
920 /* Bump up the high-water mark. Now alpha is omega. */
921 obstack_finish (&dont_print_vb_obstack
);
924 for (i
= 0; i
< n_baseclasses
; i
++)
927 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
928 char *basename
= TYPE_NAME (baseclass
);
931 if (BASETYPE_VIA_VIRTUAL (type
, i
))
933 struct type
**first_dont_print
934 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
936 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
940 if (baseclass
== first_dont_print
[j
])
943 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
946 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
950 fprintf_filtered (stream
, "\n");
951 print_spaces_filtered (2 * recurse
, stream
);
953 fputs_filtered ("<", stream
);
954 /* Not sure what the best notation is in the case where there is no
957 fputs_filtered (basename
? basename
: "", stream
);
958 fputs_filtered ("> = ", stream
);
960 /* The virtual base class pointer might have been clobbered by the
961 user program. Make sure that it still points to a valid memory
964 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
966 /* FIXME (alloc): not safe is baseclass is really really big. */
967 base_valaddr
= (char *) alloca (TYPE_LENGTH (baseclass
));
968 if (target_read_memory (address
+ boffset
, base_valaddr
,
969 TYPE_LENGTH (baseclass
)) != 0)
973 base_valaddr
= valaddr
+ boffset
;
976 fprintf_filtered (stream
, "<invalid address>");
978 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
979 stream
, format
, recurse
, pretty
,
980 (struct type
**) obstack_base (&dont_print_vb_obstack
),
982 fputs_filtered (", ", stream
);
988 if (dont_print_vb
== 0)
990 /* Free the space used to deal with the printing
991 of this type from top level. */
992 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
993 /* Reset watermark so that we can continue protecting
994 ourselves from whatever we were protecting ourselves. */
995 dont_print_vb_obstack
= tmp_obstack
;
999 /* Print value of a static member.
1000 To avoid infinite recursion when printing a class that contains
1001 a static instance of the class, we keep the addresses of all printed
1002 static member classes in an obstack and refuse to print them more
1005 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1006 have the same meanings as in c_val_print. */
1009 pascal_object_print_static_field (struct type
*type
, struct value
*val
,
1010 struct ui_file
*stream
, int format
,
1011 int recurse
, enum val_prettyprint pretty
)
1013 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1015 CORE_ADDR
*first_dont_print
;
1019 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1020 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1025 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1027 fputs_filtered ("<same as static member of an already seen type>",
1033 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1034 sizeof (CORE_ADDR
));
1036 CHECK_TYPEDEF (type
);
1037 pascal_object_print_value_fields (type
, VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
1038 stream
, format
, recurse
, pretty
, NULL
, 1);
1041 val_print (type
, VALUE_CONTENTS (val
), 0, VALUE_ADDRESS (val
),
1042 stream
, format
, 0, recurse
, pretty
);
1046 pascal_object_print_class_member (char *valaddr
, struct type
*domain
,
1047 struct ui_file
*stream
, char *prefix
)
1050 /* VAL is a byte offset into the structure type DOMAIN.
1051 Find the name of the field for that offset and
1055 register unsigned int i
;
1056 unsigned len
= TYPE_NFIELDS (domain
);
1057 /* @@ Make VAL into bit offset */
1058 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1059 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1061 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1065 if (val
< bitpos
&& i
!= 0)
1067 /* Somehow pointing into a field. */
1069 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1080 fprintf_filtered (stream
, prefix
);
1081 name
= type_name_no_tag (domain
);
1083 fputs_filtered (name
, stream
);
1085 pascal_type_print_base (domain
, stream
, 0, 0);
1086 fprintf_filtered (stream
, "::");
1087 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1089 fprintf_filtered (stream
, " + %d bytes", extra
);
1091 fprintf_filtered (stream
, " (offset in bits)");
1094 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1099 _initialize_pascal_valprint (void)
1102 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1103 (char *) &pascal_static_field_print
,
1104 "Set printing of pascal static members.",
1107 /* Turn on printing of static fields. */
1108 pascal_static_field_print
= 1;