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 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 /* 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
));
150 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
152 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
154 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
156 pascal_object_print_class_member (valaddr
+ embedded_offset
,
157 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
162 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
163 print_unpacked_pointer
:
164 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
166 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
168 /* Try to print what function it points to. */
169 print_address_demangle (addr
, stream
, demangle
);
170 /* Return value is irrelevant except for string pointers. */
174 if (addressprint
&& format
!= 's')
176 print_address_numeric (addr
, 1, stream
);
179 /* For a pointer to char or unsigned char, also print the string
180 pointed to, unless pointer is null. */
181 if (TYPE_LENGTH (elttype
) == 1
182 && TYPE_CODE (elttype
) == TYPE_CODE_INT
183 && (format
== 0 || format
== 's')
186 /* no wide string yet */
187 i
= val_print_string (addr
, -1, 1, stream
);
189 /* also for pointers to pascal strings */
190 /* Note: this is Free Pascal specific:
191 as GDB does not recognize stabs pascal strings
192 Pascal strings are mapped to records
193 with lowercase names PM */
194 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
195 &string_pos
, &char_size
, NULL
)
198 ULONGEST string_length
;
200 buffer
= xmalloc (length_size
);
201 read_memory (addr
+ length_pos
, buffer
, length_size
);
202 string_length
= extract_unsigned_integer (buffer
, length_size
);
204 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
206 else if (pascal_object_is_vtbl_member (type
))
208 /* print vtbl's nicely */
209 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
211 struct minimal_symbol
*msymbol
=
212 lookup_minimal_symbol_by_pc (vt_address
);
213 if ((msymbol
!= NULL
)
214 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
216 fputs_filtered (" <", stream
);
217 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
218 fputs_filtered (">", stream
);
220 if (vt_address
&& vtblprint
)
222 struct value
*vt_val
;
223 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
, NULL
);
234 wtype
= SYMBOL_TYPE (wsym
);
238 wtype
= TYPE_TARGET_TYPE (type
);
240 vt_val
= value_at (wtype
, vt_address
);
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 /* Extract the address, assume that it is unsigned. */
276 print_address_numeric
277 (extract_unsigned_integer (valaddr
+ embedded_offset
,
278 TARGET_PTR_BIT
/ HOST_CHAR_BIT
),
281 fputs_filtered (": ", stream
);
283 /* De-reference the reference. */
286 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
288 struct value
*deref_val
=
290 (TYPE_TARGET_TYPE (type
),
291 unpack_pointer (lookup_pointer_type (builtin_type_void
),
292 valaddr
+ embedded_offset
));
293 val_print (value_type (deref_val
),
294 VALUE_CONTENTS (deref_val
), 0,
295 VALUE_ADDRESS (deref_val
), stream
, format
,
296 deref_ref
, 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 val_print (type
, VALUE_CONTENTS (val
), VALUE_EMBEDDED_OFFSET (val
),
568 VALUE_ADDRESS (val
) + value_offset (val
),
569 stream
, format
, 1, 0, pretty
);
573 /******************************************************************************
574 Inserted from cp-valprint
575 ******************************************************************************/
577 extern int vtblprint
; /* Controls printing of vtbl's */
578 extern int objectprint
; /* Controls looking up an object's derived type
579 using what we find in its vtables. */
580 static int pascal_static_field_print
; /* Controls printing of static fields. */
582 static struct obstack dont_print_vb_obstack
;
583 static struct obstack dont_print_statmem_obstack
;
585 static void pascal_object_print_static_field (struct type
*, struct value
*,
586 struct ui_file
*, int, int,
587 enum val_prettyprint
);
590 pascal_object_print_value (struct type
*, char *, CORE_ADDR
, struct ui_file
*,
591 int, int, enum val_prettyprint
, struct type
**);
594 pascal_object_print_class_method (char *valaddr
, struct type
*type
,
595 struct ui_file
*stream
)
598 struct fn_field
*f
= NULL
;
607 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
609 domain
= TYPE_DOMAIN_TYPE (target_type
);
610 if (domain
== (struct type
*) NULL
)
612 fprintf_filtered (stream
, "<unknown>");
615 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
616 if (METHOD_PTR_IS_VIRTUAL (addr
))
618 offset
= METHOD_PTR_TO_VOFFSET (addr
);
619 len
= TYPE_NFN_FIELDS (domain
);
620 for (i
= 0; i
< len
; i
++)
622 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
623 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
625 check_stub_method_group (domain
, i
);
626 for (j
= 0; j
< len2
; j
++)
628 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
638 sym
= find_pc_function (addr
);
641 error ("invalid pointer to member function");
643 len
= TYPE_NFN_FIELDS (domain
);
644 for (i
= 0; i
< len
; i
++)
646 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
647 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
649 check_stub_method_group (domain
, i
);
650 for (j
= 0; j
< len2
; j
++)
652 if (DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
660 char *demangled_name
;
662 fprintf_filtered (stream
, "&");
663 fputs_filtered (kind
, stream
);
664 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
665 DMGL_ANSI
| DMGL_PARAMS
);
666 if (demangled_name
== NULL
)
667 fprintf_filtered (stream
, "<badly mangled name %s>",
668 TYPE_FN_FIELD_PHYSNAME (f
, j
));
671 fputs_filtered (demangled_name
, stream
);
672 xfree (demangled_name
);
677 fprintf_filtered (stream
, "(");
678 type_print (type
, "", stream
, -1);
679 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
683 /* It was changed to this after 2.4.5. */
684 const char pascal_vtbl_ptr_name
[] =
685 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
687 /* Return truth value for assertion that TYPE is of the type
688 "pointer to virtual function". */
691 pascal_object_is_vtbl_ptr_type (struct type
*type
)
693 char *typename
= type_name_no_tag (type
);
695 return (typename
!= NULL
696 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
699 /* Return truth value for the assertion that TYPE is of the type
700 "pointer to virtual function table". */
703 pascal_object_is_vtbl_member (struct type
*type
)
705 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
707 type
= TYPE_TARGET_TYPE (type
);
708 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
710 type
= TYPE_TARGET_TYPE (type
);
711 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
712 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
714 /* Virtual functions tables are full of pointers
715 to virtual functions. */
716 return pascal_object_is_vtbl_ptr_type (type
);
723 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
724 print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
726 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
727 same meanings as in pascal_object_print_value and c_val_print.
729 DONT_PRINT is an array of baseclass types that we
730 should not print, or zero if called from top level. */
733 pascal_object_print_value_fields (struct type
*type
, char *valaddr
,
734 CORE_ADDR address
, struct ui_file
*stream
,
735 int format
, int recurse
,
736 enum val_prettyprint pretty
,
737 struct type
**dont_print_vb
,
738 int dont_print_statmem
)
740 int i
, len
, n_baseclasses
;
741 struct obstack tmp_obstack
;
742 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
744 CHECK_TYPEDEF (type
);
746 fprintf_filtered (stream
, "{");
747 len
= TYPE_NFIELDS (type
);
748 n_baseclasses
= TYPE_N_BASECLASSES (type
);
750 /* Print out baseclasses such that we don't print
751 duplicates of virtual baseclasses. */
752 if (n_baseclasses
> 0)
753 pascal_object_print_value (type
, valaddr
, address
, stream
,
754 format
, recurse
+ 1, pretty
, dont_print_vb
);
756 if (!len
&& n_baseclasses
== 1)
757 fprintf_filtered (stream
, "<No data fields>");
762 if (dont_print_statmem
== 0)
764 /* If we're at top level, carve out a completely fresh
765 chunk of the obstack and use that until this particular
766 invocation returns. */
767 tmp_obstack
= dont_print_statmem_obstack
;
768 obstack_finish (&dont_print_statmem_obstack
);
771 for (i
= n_baseclasses
; i
< len
; i
++)
773 /* If requested, skip printing of static fields. */
774 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
777 fprintf_filtered (stream
, ", ");
778 else if (n_baseclasses
> 0)
782 fprintf_filtered (stream
, "\n");
783 print_spaces_filtered (2 + 2 * recurse
, stream
);
784 fputs_filtered ("members of ", stream
);
785 fputs_filtered (type_name_no_tag (type
), stream
);
786 fputs_filtered (": ", stream
);
793 fprintf_filtered (stream
, "\n");
794 print_spaces_filtered (2 + 2 * recurse
, stream
);
798 wrap_here (n_spaces (2 + 2 * recurse
));
802 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
803 fputs_filtered ("\"( ptr \"", stream
);
805 fputs_filtered ("\"( nodef \"", stream
);
806 if (TYPE_FIELD_STATIC (type
, i
))
807 fputs_filtered ("static ", stream
);
808 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
810 DMGL_PARAMS
| DMGL_ANSI
);
811 fputs_filtered ("\" \"", stream
);
812 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
814 DMGL_PARAMS
| DMGL_ANSI
);
815 fputs_filtered ("\") \"", stream
);
819 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
821 if (TYPE_FIELD_STATIC (type
, i
))
822 fputs_filtered ("static ", stream
);
823 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
825 DMGL_PARAMS
| DMGL_ANSI
);
826 annotate_field_name_end ();
827 fputs_filtered (" = ", stream
);
828 annotate_field_value ();
831 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
835 /* Bitfields require special handling, especially due to byte
837 if (TYPE_FIELD_IGNORE (type
, i
))
839 fputs_filtered ("<optimized out or zero length>", stream
);
843 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
844 unpack_field_as_long (type
, valaddr
, i
));
846 val_print (TYPE_FIELD_TYPE (type
, i
), VALUE_CONTENTS (v
), 0, 0,
847 stream
, format
, 0, recurse
+ 1, pretty
);
852 if (TYPE_FIELD_IGNORE (type
, i
))
854 fputs_filtered ("<optimized out or zero length>", stream
);
856 else if (TYPE_FIELD_STATIC (type
, i
))
858 /* struct value *v = value_static_field (type, i); v4.17 specific */
860 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
861 unpack_field_as_long (type
, valaddr
, i
));
864 fputs_filtered ("<optimized out>", stream
);
866 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
867 stream
, format
, recurse
+ 1,
872 /* val_print (TYPE_FIELD_TYPE (type, i),
873 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
874 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
875 stream, format, 0, recurse + 1, pretty); */
876 val_print (TYPE_FIELD_TYPE (type
, i
),
877 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
878 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
879 stream
, format
, 0, recurse
+ 1, pretty
);
882 annotate_field_end ();
885 if (dont_print_statmem
== 0)
887 /* Free the space used to deal with the printing
888 of the members from top level. */
889 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
890 dont_print_statmem_obstack
= tmp_obstack
;
895 fprintf_filtered (stream
, "\n");
896 print_spaces_filtered (2 * recurse
, stream
);
899 fprintf_filtered (stream
, "}");
902 /* Special val_print routine to avoid printing multiple copies of virtual
906 pascal_object_print_value (struct type
*type
, char *valaddr
, CORE_ADDR address
,
907 struct ui_file
*stream
, int format
, int recurse
,
908 enum val_prettyprint pretty
,
909 struct type
**dont_print_vb
)
911 struct obstack tmp_obstack
;
912 struct type
**last_dont_print
913 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
914 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
916 if (dont_print_vb
== 0)
918 /* If we're at top level, carve out a completely fresh
919 chunk of the obstack and use that until this particular
920 invocation returns. */
921 tmp_obstack
= dont_print_vb_obstack
;
922 /* Bump up the high-water mark. Now alpha is omega. */
923 obstack_finish (&dont_print_vb_obstack
);
926 for (i
= 0; i
< n_baseclasses
; i
++)
929 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
930 char *basename
= TYPE_NAME (baseclass
);
933 if (BASETYPE_VIA_VIRTUAL (type
, i
))
935 struct type
**first_dont_print
936 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
938 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
942 if (baseclass
== first_dont_print
[j
])
945 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
948 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
952 fprintf_filtered (stream
, "\n");
953 print_spaces_filtered (2 * recurse
, stream
);
955 fputs_filtered ("<", stream
);
956 /* Not sure what the best notation is in the case where there is no
959 fputs_filtered (basename
? basename
: "", stream
);
960 fputs_filtered ("> = ", stream
);
962 /* The virtual base class pointer might have been clobbered by the
963 user program. Make sure that it still points to a valid memory
966 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
968 /* FIXME (alloc): not safe is baseclass is really really big. */
969 base_valaddr
= (char *) alloca (TYPE_LENGTH (baseclass
));
970 if (target_read_memory (address
+ boffset
, base_valaddr
,
971 TYPE_LENGTH (baseclass
)) != 0)
975 base_valaddr
= valaddr
+ boffset
;
978 fprintf_filtered (stream
, "<invalid address>");
980 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
981 stream
, format
, recurse
, pretty
,
982 (struct type
**) obstack_base (&dont_print_vb_obstack
),
984 fputs_filtered (", ", stream
);
990 if (dont_print_vb
== 0)
992 /* Free the space used to deal with the printing
993 of this type from top level. */
994 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
995 /* Reset watermark so that we can continue protecting
996 ourselves from whatever we were protecting ourselves. */
997 dont_print_vb_obstack
= tmp_obstack
;
1001 /* Print value of a static member.
1002 To avoid infinite recursion when printing a class that contains
1003 a static instance of the class, we keep the addresses of all printed
1004 static member classes in an obstack and refuse to print them more
1007 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1008 have the same meanings as in c_val_print. */
1011 pascal_object_print_static_field (struct type
*type
, struct value
*val
,
1012 struct ui_file
*stream
, int format
,
1013 int recurse
, enum val_prettyprint pretty
)
1015 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1017 CORE_ADDR
*first_dont_print
;
1021 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1022 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1027 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1029 fputs_filtered ("<same as static member of an already seen type>",
1035 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1036 sizeof (CORE_ADDR
));
1038 CHECK_TYPEDEF (type
);
1039 pascal_object_print_value_fields (type
, VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
1040 stream
, format
, recurse
, pretty
, NULL
, 1);
1043 val_print (type
, VALUE_CONTENTS (val
), 0, VALUE_ADDRESS (val
),
1044 stream
, format
, 0, recurse
, pretty
);
1048 pascal_object_print_class_member (char *valaddr
, struct type
*domain
,
1049 struct ui_file
*stream
, char *prefix
)
1052 /* VAL is a byte offset into the structure type DOMAIN.
1053 Find the name of the field for that offset and
1058 unsigned len
= TYPE_NFIELDS (domain
);
1059 /* @@ Make VAL into bit offset */
1060 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1061 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1063 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1067 if (val
< bitpos
&& i
!= 0)
1069 /* Somehow pointing into a field. */
1071 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1082 fputs_filtered (prefix
, stream
);
1083 name
= type_name_no_tag (domain
);
1085 fputs_filtered (name
, stream
);
1087 pascal_type_print_base (domain
, stream
, 0, 0);
1088 fprintf_filtered (stream
, "::");
1089 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1091 fprintf_filtered (stream
, " + %d bytes", extra
);
1093 fprintf_filtered (stream
, " (offset in bits)");
1096 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1099 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
1102 _initialize_pascal_valprint (void)
1104 deprecated_add_show_from_set
1105 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1106 (char *) &pascal_static_field_print
,
1107 "Set printing of pascal static members.",
1110 /* Turn on printing of static fields. */
1111 pascal_static_field_print
= 1;