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 /* 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
;
226 struct block
*block
= (struct block
*) NULL
;
230 wsym
= lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol
), block
,
231 VAR_DOMAIN
, &is_this_fld
, &s
);
235 wtype
= SYMBOL_TYPE (wsym
);
239 wtype
= TYPE_TARGET_TYPE (type
);
241 vt_val
= value_at (wtype
, vt_address
, NULL
);
242 val_print (VALUE_TYPE (vt_val
), VALUE_CONTENTS (vt_val
), 0,
243 VALUE_ADDRESS (vt_val
), stream
, format
,
244 deref_ref
, recurse
+ 1, pretty
);
247 fprintf_filtered (stream
, "\n");
248 print_spaces_filtered (2 + 2 * recurse
, stream
);
253 /* Return number of characters printed, including the terminating
254 '\0' if we reached the end. val_print_string takes care including
255 the terminating '\0' if necessary. */
260 case TYPE_CODE_MEMBER
:
261 error ("not implemented: member type in pascal_val_print");
265 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
266 if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
268 pascal_object_print_class_member (valaddr
+ embedded_offset
,
269 TYPE_DOMAIN_TYPE (elttype
),
275 fprintf_filtered (stream
, "@");
276 /* Extract the address, assume that it is unsigned. */
277 print_address_numeric
278 (extract_unsigned_integer (valaddr
+ embedded_offset
,
279 TARGET_PTR_BIT
/ HOST_CHAR_BIT
),
282 fputs_filtered (": ", stream
);
284 /* De-reference the reference. */
287 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
289 struct value
*deref_val
=
291 (TYPE_TARGET_TYPE (type
),
292 unpack_pointer (lookup_pointer_type (builtin_type_void
),
293 valaddr
+ embedded_offset
),
295 val_print (VALUE_TYPE (deref_val
),
296 VALUE_CONTENTS (deref_val
), 0,
297 VALUE_ADDRESS (deref_val
), stream
, format
,
298 deref_ref
, recurse
+ 1, pretty
);
301 fputs_filtered ("???", stream
);
305 case TYPE_CODE_UNION
:
306 if (recurse
&& !unionprint
)
308 fprintf_filtered (stream
, "{...}");
312 case TYPE_CODE_STRUCT
:
313 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
315 /* Print the unmangled name if desired. */
316 /* Print vtable entry - we only get here if NOT using
317 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
318 /* Extract the address, assume that it is unsigned. */
319 print_address_demangle
320 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
321 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
326 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
327 &string_pos
, &char_size
, NULL
))
329 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
330 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
333 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
334 recurse
, pretty
, NULL
, 0);
341 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
344 len
= TYPE_NFIELDS (type
);
345 val
= unpack_long (type
, valaddr
+ embedded_offset
);
346 for (i
= 0; i
< len
; i
++)
349 if (val
== TYPE_FIELD_BITPOS (type
, i
))
356 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
360 print_longest (stream
, 'd', 0, val
);
367 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
370 /* FIXME, we should consider, at least for ANSI C language, eliminating
371 the distinction made between FUNCs and POINTERs to FUNCs. */
372 fprintf_filtered (stream
, "{");
373 type_print (type
, "", stream
, -1);
374 fprintf_filtered (stream
, "} ");
375 /* Try to print what function it points to, and its address. */
376 print_address_demangle (address
, stream
, demangle
);
380 format
= format
? format
: output_format
;
382 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
385 val
= unpack_long (type
, valaddr
+ embedded_offset
);
387 fputs_filtered ("false", stream
);
389 fputs_filtered ("true", stream
);
392 fputs_filtered ("true (", stream
);
393 fprintf_filtered (stream
, "%ld)", (long int) val
);
398 case TYPE_CODE_RANGE
:
399 /* FIXME: create_range_type does not set the unsigned bit in a
400 range type (I think it probably should copy it from the target
401 type), so we won't print values which are too large to
402 fit in a signed integer correctly. */
403 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
404 print with the target type, though, because the size of our type
405 and the target type might differ). */
409 format
= format
? format
: output_format
;
412 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
416 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
421 format
= format
? format
: output_format
;
424 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
428 val
= unpack_long (type
, valaddr
+ embedded_offset
);
429 if (TYPE_UNSIGNED (type
))
430 fprintf_filtered (stream
, "%u", (unsigned int) val
);
432 fprintf_filtered (stream
, "%d", (int) val
);
433 fputs_filtered (" ", stream
);
434 LA_PRINT_CHAR ((unsigned char) val
, stream
);
441 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
445 print_floating (valaddr
+ embedded_offset
, type
, stream
);
449 case TYPE_CODE_BITSTRING
:
451 elttype
= TYPE_INDEX_TYPE (type
);
452 CHECK_TYPEDEF (elttype
);
453 if (TYPE_STUB (elttype
))
455 fprintf_filtered (stream
, "<incomplete type>");
461 struct type
*range
= elttype
;
462 LONGEST low_bound
, high_bound
;
464 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
468 fputs_filtered ("B'", stream
);
470 fputs_filtered ("[", stream
);
472 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
476 fputs_filtered ("<error value>", stream
);
480 for (i
= low_bound
; i
<= high_bound
; i
++)
482 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
486 goto maybe_bad_bstring
;
489 fprintf_filtered (stream
, "%d", element
);
493 fputs_filtered (", ", stream
);
494 print_type_scalar (range
, i
, stream
);
497 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
500 fputs_filtered ("..", stream
);
501 while (i
+ 1 <= high_bound
502 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
504 print_type_scalar (range
, j
, stream
);
510 fputs_filtered ("'", stream
);
512 fputs_filtered ("]", stream
);
517 fprintf_filtered (stream
, "void");
520 case TYPE_CODE_ERROR
:
521 fprintf_filtered (stream
, "<error type>");
524 case TYPE_CODE_UNDEF
:
525 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
526 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
527 and no complete type for struct foo in that file. */
528 fprintf_filtered (stream
, "<incomplete type>");
532 error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type
));
539 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
540 enum val_prettyprint pretty
)
542 struct type
*type
= VALUE_TYPE (val
);
544 /* If it is a pointer, indicate what it points to.
546 Print type also if it is a reference.
548 Object pascal: if it is a member pointer, we will take care
549 of that when we print it. */
550 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
551 TYPE_CODE (type
) == TYPE_CODE_REF
)
553 /* Hack: remove (char *) for char strings. Their
554 type is indicated by the quoted string anyway. */
555 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
556 TYPE_NAME (type
) == NULL
&&
557 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
&&
558 STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char"))
564 fprintf_filtered (stream
, "(");
565 type_print (type
, "", stream
, -1);
566 fprintf_filtered (stream
, ") ");
569 return val_print (type
, VALUE_CONTENTS (val
), VALUE_EMBEDDED_OFFSET (val
),
570 VALUE_ADDRESS (val
) + VALUE_OFFSET (val
),
571 stream
, format
, 1, 0, pretty
);
575 /******************************************************************************
576 Inserted from cp-valprint
577 ******************************************************************************/
579 extern int vtblprint
; /* Controls printing of vtbl's */
580 extern int objectprint
; /* Controls looking up an object's derived type
581 using what we find in its vtables. */
582 static int pascal_static_field_print
; /* Controls printing of static fields. */
584 static struct obstack dont_print_vb_obstack
;
585 static struct obstack dont_print_statmem_obstack
;
587 static void pascal_object_print_static_field (struct type
*, struct value
*,
588 struct ui_file
*, int, int,
589 enum val_prettyprint
);
592 pascal_object_print_value (struct type
*, char *, CORE_ADDR
, struct ui_file
*,
593 int, int, enum val_prettyprint
, struct type
**);
596 pascal_object_print_class_method (char *valaddr
, struct type
*type
,
597 struct ui_file
*stream
)
600 struct fn_field
*f
= NULL
;
609 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
611 domain
= TYPE_DOMAIN_TYPE (target_type
);
612 if (domain
== (struct type
*) NULL
)
614 fprintf_filtered (stream
, "<unknown>");
617 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
618 if (METHOD_PTR_IS_VIRTUAL (addr
))
620 offset
= METHOD_PTR_TO_VOFFSET (addr
);
621 len
= TYPE_NFN_FIELDS (domain
);
622 for (i
= 0; i
< len
; i
++)
624 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
625 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
627 check_stub_method_group (domain
, i
);
628 for (j
= 0; j
< len2
; j
++)
630 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
640 sym
= find_pc_function (addr
);
643 error ("invalid pointer to member function");
645 len
= TYPE_NFN_FIELDS (domain
);
646 for (i
= 0; i
< len
; i
++)
648 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
649 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
651 check_stub_method_group (domain
, i
);
652 for (j
= 0; j
< len2
; j
++)
654 if (STREQ (DEPRECATED_SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
662 char *demangled_name
;
664 fprintf_filtered (stream
, "&");
665 fprintf_filtered (stream
, kind
);
666 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
667 DMGL_ANSI
| DMGL_PARAMS
);
668 if (demangled_name
== NULL
)
669 fprintf_filtered (stream
, "<badly mangled name %s>",
670 TYPE_FN_FIELD_PHYSNAME (f
, j
));
673 fputs_filtered (demangled_name
, stream
);
674 xfree (demangled_name
);
679 fprintf_filtered (stream
, "(");
680 type_print (type
, "", stream
, -1);
681 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
685 /* It was changed to this after 2.4.5. */
686 const char pascal_vtbl_ptr_name
[] =
687 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
689 /* Return truth value for assertion that TYPE is of the type
690 "pointer to virtual function". */
693 pascal_object_is_vtbl_ptr_type (struct type
*type
)
695 char *typename
= type_name_no_tag (type
);
697 return (typename
!= NULL
698 && (STREQ (typename
, pascal_vtbl_ptr_name
)));
701 /* Return truth value for the assertion that TYPE is of the type
702 "pointer to virtual function table". */
705 pascal_object_is_vtbl_member (struct type
*type
)
707 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
709 type
= TYPE_TARGET_TYPE (type
);
710 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
712 type
= TYPE_TARGET_TYPE (type
);
713 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
714 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
716 /* Virtual functions tables are full of pointers
717 to virtual functions. */
718 return pascal_object_is_vtbl_ptr_type (type
);
725 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
726 print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
728 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
729 same meanings as in pascal_object_print_value and c_val_print.
731 DONT_PRINT is an array of baseclass types that we
732 should not print, or zero if called from top level. */
735 pascal_object_print_value_fields (struct type
*type
, char *valaddr
,
736 CORE_ADDR address
, struct ui_file
*stream
,
737 int format
, int recurse
,
738 enum val_prettyprint pretty
,
739 struct type
**dont_print_vb
,
740 int dont_print_statmem
)
742 int i
, len
, n_baseclasses
;
743 struct obstack tmp_obstack
;
744 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
746 CHECK_TYPEDEF (type
);
748 fprintf_filtered (stream
, "{");
749 len
= TYPE_NFIELDS (type
);
750 n_baseclasses
= TYPE_N_BASECLASSES (type
);
752 /* Print out baseclasses such that we don't print
753 duplicates of virtual baseclasses. */
754 if (n_baseclasses
> 0)
755 pascal_object_print_value (type
, valaddr
, address
, stream
,
756 format
, recurse
+ 1, pretty
, dont_print_vb
);
758 if (!len
&& n_baseclasses
== 1)
759 fprintf_filtered (stream
, "<No data fields>");
764 if (dont_print_statmem
== 0)
766 /* If we're at top level, carve out a completely fresh
767 chunk of the obstack and use that until this particular
768 invocation returns. */
769 tmp_obstack
= dont_print_statmem_obstack
;
770 obstack_finish (&dont_print_statmem_obstack
);
773 for (i
= n_baseclasses
; i
< len
; i
++)
775 /* If requested, skip printing of static fields. */
776 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
779 fprintf_filtered (stream
, ", ");
780 else if (n_baseclasses
> 0)
784 fprintf_filtered (stream
, "\n");
785 print_spaces_filtered (2 + 2 * recurse
, stream
);
786 fputs_filtered ("members of ", stream
);
787 fputs_filtered (type_name_no_tag (type
), stream
);
788 fputs_filtered (": ", stream
);
795 fprintf_filtered (stream
, "\n");
796 print_spaces_filtered (2 + 2 * recurse
, stream
);
800 wrap_here (n_spaces (2 + 2 * recurse
));
804 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
805 fputs_filtered ("\"( ptr \"", stream
);
807 fputs_filtered ("\"( nodef \"", stream
);
808 if (TYPE_FIELD_STATIC (type
, i
))
809 fputs_filtered ("static ", stream
);
810 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
812 DMGL_PARAMS
| DMGL_ANSI
);
813 fputs_filtered ("\" \"", stream
);
814 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
816 DMGL_PARAMS
| DMGL_ANSI
);
817 fputs_filtered ("\") \"", stream
);
821 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
823 if (TYPE_FIELD_STATIC (type
, i
))
824 fputs_filtered ("static ", stream
);
825 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
827 DMGL_PARAMS
| DMGL_ANSI
);
828 annotate_field_name_end ();
829 fputs_filtered (" = ", stream
);
830 annotate_field_value ();
833 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
837 /* Bitfields require special handling, especially due to byte
839 if (TYPE_FIELD_IGNORE (type
, i
))
841 fputs_filtered ("<optimized out or zero length>", stream
);
845 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
846 unpack_field_as_long (type
, valaddr
, i
));
848 val_print (TYPE_FIELD_TYPE (type
, i
), VALUE_CONTENTS (v
), 0, 0,
849 stream
, format
, 0, recurse
+ 1, pretty
);
854 if (TYPE_FIELD_IGNORE (type
, i
))
856 fputs_filtered ("<optimized out or zero length>", stream
);
858 else if (TYPE_FIELD_STATIC (type
, i
))
860 /* struct value *v = value_static_field (type, i); v4.17 specific */
862 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
863 unpack_field_as_long (type
, valaddr
, i
));
866 fputs_filtered ("<optimized out>", stream
);
868 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
869 stream
, format
, recurse
+ 1,
874 /* val_print (TYPE_FIELD_TYPE (type, i),
875 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
876 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
877 stream, format, 0, recurse + 1, pretty); */
878 val_print (TYPE_FIELD_TYPE (type
, i
),
879 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
880 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
881 stream
, format
, 0, recurse
+ 1, pretty
);
884 annotate_field_end ();
887 if (dont_print_statmem
== 0)
889 /* Free the space used to deal with the printing
890 of the members from top level. */
891 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
892 dont_print_statmem_obstack
= tmp_obstack
;
897 fprintf_filtered (stream
, "\n");
898 print_spaces_filtered (2 * recurse
, stream
);
901 fprintf_filtered (stream
, "}");
904 /* Special val_print routine to avoid printing multiple copies of virtual
908 pascal_object_print_value (struct type
*type
, char *valaddr
, CORE_ADDR address
,
909 struct ui_file
*stream
, int format
, int recurse
,
910 enum val_prettyprint pretty
,
911 struct type
**dont_print_vb
)
913 struct obstack tmp_obstack
;
914 struct type
**last_dont_print
915 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
916 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
918 if (dont_print_vb
== 0)
920 /* If we're at top level, carve out a completely fresh
921 chunk of the obstack and use that until this particular
922 invocation returns. */
923 tmp_obstack
= dont_print_vb_obstack
;
924 /* Bump up the high-water mark. Now alpha is omega. */
925 obstack_finish (&dont_print_vb_obstack
);
928 for (i
= 0; i
< n_baseclasses
; i
++)
931 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
932 char *basename
= TYPE_NAME (baseclass
);
935 if (BASETYPE_VIA_VIRTUAL (type
, i
))
937 struct type
**first_dont_print
938 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
940 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
944 if (baseclass
== first_dont_print
[j
])
947 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
950 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
954 fprintf_filtered (stream
, "\n");
955 print_spaces_filtered (2 * recurse
, stream
);
957 fputs_filtered ("<", stream
);
958 /* Not sure what the best notation is in the case where there is no
961 fputs_filtered (basename
? basename
: "", stream
);
962 fputs_filtered ("> = ", stream
);
964 /* The virtual base class pointer might have been clobbered by the
965 user program. Make sure that it still points to a valid memory
968 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
970 /* FIXME (alloc): not safe is baseclass is really really big. */
971 base_valaddr
= (char *) alloca (TYPE_LENGTH (baseclass
));
972 if (target_read_memory (address
+ boffset
, base_valaddr
,
973 TYPE_LENGTH (baseclass
)) != 0)
977 base_valaddr
= valaddr
+ boffset
;
980 fprintf_filtered (stream
, "<invalid address>");
982 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
983 stream
, format
, recurse
, pretty
,
984 (struct type
**) obstack_base (&dont_print_vb_obstack
),
986 fputs_filtered (", ", stream
);
992 if (dont_print_vb
== 0)
994 /* Free the space used to deal with the printing
995 of this type from top level. */
996 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
997 /* Reset watermark so that we can continue protecting
998 ourselves from whatever we were protecting ourselves. */
999 dont_print_vb_obstack
= tmp_obstack
;
1003 /* Print value of a static member.
1004 To avoid infinite recursion when printing a class that contains
1005 a static instance of the class, we keep the addresses of all printed
1006 static member classes in an obstack and refuse to print them more
1009 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1010 have the same meanings as in c_val_print. */
1013 pascal_object_print_static_field (struct type
*type
, struct value
*val
,
1014 struct ui_file
*stream
, int format
,
1015 int recurse
, enum val_prettyprint pretty
)
1017 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1019 CORE_ADDR
*first_dont_print
;
1023 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1024 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1029 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1031 fputs_filtered ("<same as static member of an already seen type>",
1037 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1038 sizeof (CORE_ADDR
));
1040 CHECK_TYPEDEF (type
);
1041 pascal_object_print_value_fields (type
, VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
1042 stream
, format
, recurse
, pretty
, NULL
, 1);
1045 val_print (type
, VALUE_CONTENTS (val
), 0, VALUE_ADDRESS (val
),
1046 stream
, format
, 0, recurse
, pretty
);
1050 pascal_object_print_class_member (char *valaddr
, struct type
*domain
,
1051 struct ui_file
*stream
, char *prefix
)
1054 /* VAL is a byte offset into the structure type DOMAIN.
1055 Find the name of the field for that offset and
1059 register unsigned int i
;
1060 unsigned len
= TYPE_NFIELDS (domain
);
1061 /* @@ Make VAL into bit offset */
1062 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1063 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1065 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1069 if (val
< bitpos
&& i
!= 0)
1071 /* Somehow pointing into a field. */
1073 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1084 fprintf_filtered (stream
, prefix
);
1085 name
= type_name_no_tag (domain
);
1087 fputs_filtered (name
, stream
);
1089 pascal_type_print_base (domain
, stream
, 0, 0);
1090 fprintf_filtered (stream
, "::");
1091 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1093 fprintf_filtered (stream
, " + %d bytes", extra
);
1095 fprintf_filtered (stream
, " (offset in bits)");
1098 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1103 _initialize_pascal_valprint (void)
1106 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1107 (char *) &pascal_static_field_print
,
1108 "Set printing of pascal static members.",
1111 /* Turn on printing of static fields. */
1112 pascal_static_field_print
= 1;