1 /* Support for printing Pascal values for GDB, the GNU debugger.
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"
45 /* Print data of type TYPE located at VALADDR (within GDB), which came from
46 the inferior at address ADDRESS, onto stdio stream STREAM according to
47 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
50 If the data are a string pointer, returns the number of string characters
53 If DEREF_REF is nonzero, then dereference references, otherwise just print
56 The PRETTY parameter controls prettyprinting. */
60 pascal_val_print (struct type
*type
, char *valaddr
, int embedded_offset
,
61 CORE_ADDR address
, struct ui_file
*stream
, int format
,
62 int deref_ref
, int recurse
, enum val_prettyprint pretty
)
64 register unsigned int i
= 0; /* Number of characters printed */
68 int length_pos
, length_size
, string_pos
;
74 switch (TYPE_CODE (type
))
77 return c_val_print (type
, valaddr
, embedded_offset
, address
, stream
,
78 format
, deref_ref
, recurse
, pretty
);
81 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
83 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
84 eltlen
= TYPE_LENGTH (elttype
);
85 len
= TYPE_LENGTH (type
) / eltlen
;
86 if (prettyprint_arrays
)
88 print_spaces_filtered (2 + 2 * recurse
, stream
);
90 /* For an array of chars, print with string syntax. */
92 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
93 || ((current_language
->la_language
== language_m2
)
94 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
95 && (format
== 0 || format
== 's'))
97 /* If requested, look for the first null char and only print
99 if (stop_print_at_null
)
101 unsigned int temp_len
;
103 /* Look for a NULL char. */
105 (valaddr
+ embedded_offset
)[temp_len
]
106 && temp_len
< len
&& temp_len
< print_max
;
111 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
116 fprintf_filtered (stream
, "{");
117 /* If this is a virtual function table, print the 0th
118 entry specially, and the rest of the members normally. */
119 if (pascal_object_is_vtbl_ptr_type (elttype
))
122 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
128 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
129 format
, deref_ref
, recurse
, pretty
, i
);
130 fprintf_filtered (stream
, "}");
134 /* Array of unspecified length: treat like pointer to first elt. */
136 goto print_unpacked_pointer
;
139 if (format
&& format
!= 's')
141 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
144 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
146 /* Print the unmangled name if desired. */
147 /* Print vtable entry - we only get here if we ARE using
148 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
149 print_address_demangle (extract_address (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
153 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
154 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
156 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
158 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
160 pascal_object_print_class_member (valaddr
+ embedded_offset
,
161 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
166 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
167 print_unpacked_pointer
:
168 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
170 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
172 /* Try to print what function it points to. */
173 print_address_demangle (addr
, stream
, demangle
);
174 /* Return value is irrelevant except for string pointers. */
178 if (addressprint
&& format
!= 's')
180 print_address_numeric (addr
, 1, stream
);
183 /* For a pointer to char or unsigned char, also print the string
184 pointed to, unless pointer is null. */
185 if (TYPE_LENGTH (elttype
) == 1
186 && TYPE_CODE (elttype
) == TYPE_CODE_INT
187 && (format
== 0 || format
== 's')
190 /* no wide string yet */
191 i
= val_print_string (addr
, -1, 1, stream
);
193 /* also for pointers to pascal strings */
194 /* Note: this is Free Pascal specific:
195 as GDB does not recognize stabs pascal strings
196 Pascal strings are mapped to records
197 with lowercase names PM */
198 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
199 &string_pos
, &char_size
, NULL
)
202 ULONGEST string_length
;
204 buffer
= xmalloc (length_size
);
205 read_memory (addr
+ length_pos
, buffer
, length_size
);
206 string_length
= extract_unsigned_integer (buffer
, length_size
);
208 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
210 else if (pascal_object_is_vtbl_member (type
))
212 /* print vtbl's nicely */
213 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
215 struct minimal_symbol
*msymbol
=
216 lookup_minimal_symbol_by_pc (vt_address
);
217 if ((msymbol
!= NULL
)
218 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
220 fputs_filtered (" <", stream
);
221 fputs_filtered (SYMBOL_SOURCE_NAME (msymbol
), stream
);
222 fputs_filtered (">", stream
);
224 if (vt_address
&& vtblprint
)
226 struct value
*vt_val
;
227 struct symbol
*wsym
= (struct symbol
*) NULL
;
230 struct block
*block
= (struct block
*) NULL
;
234 wsym
= lookup_symbol (SYMBOL_NAME (msymbol
), block
,
235 VAR_NAMESPACE
, &is_this_fld
, &s
);
239 wtype
= SYMBOL_TYPE (wsym
);
243 wtype
= TYPE_TARGET_TYPE (type
);
245 vt_val
= value_at (wtype
, vt_address
, NULL
);
246 val_print (VALUE_TYPE (vt_val
), VALUE_CONTENTS (vt_val
), 0,
247 VALUE_ADDRESS (vt_val
), stream
, format
,
248 deref_ref
, recurse
+ 1, pretty
);
251 fprintf_filtered (stream
, "\n");
252 print_spaces_filtered (2 + 2 * recurse
, stream
);
257 /* Return number of characters printed, including the terminating
258 '\0' if we reached the end. val_print_string takes care including
259 the terminating '\0' if necessary. */
264 case TYPE_CODE_MEMBER
:
265 error ("not implemented: member type in pascal_val_print");
269 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
270 if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
272 pascal_object_print_class_member (valaddr
+ embedded_offset
,
273 TYPE_DOMAIN_TYPE (elttype
),
279 fprintf_filtered (stream
, "@");
280 print_address_numeric
281 (extract_address (valaddr
+ embedded_offset
,
282 TARGET_PTR_BIT
/ HOST_CHAR_BIT
), 1, stream
);
284 fputs_filtered (": ", stream
);
286 /* De-reference the reference. */
289 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
291 struct value
*deref_val
=
293 (TYPE_TARGET_TYPE (type
),
294 unpack_pointer (lookup_pointer_type (builtin_type_void
),
295 valaddr
+ embedded_offset
),
297 val_print (VALUE_TYPE (deref_val
),
298 VALUE_CONTENTS (deref_val
), 0,
299 VALUE_ADDRESS (deref_val
), stream
, format
,
300 deref_ref
, recurse
+ 1, pretty
);
303 fputs_filtered ("???", stream
);
307 case TYPE_CODE_UNION
:
308 if (recurse
&& !unionprint
)
310 fprintf_filtered (stream
, "{...}");
314 case TYPE_CODE_STRUCT
:
315 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
317 /* Print the unmangled name if desired. */
318 /* Print vtable entry - we only get here if NOT using
319 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
320 print_address_demangle (extract_address (
321 valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
322 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
327 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
328 &string_pos
, &char_size
, NULL
))
330 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
331 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
334 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
335 recurse
, pretty
, NULL
, 0);
342 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
345 len
= TYPE_NFIELDS (type
);
346 val
= unpack_long (type
, valaddr
+ embedded_offset
);
347 for (i
= 0; i
< len
; i
++)
350 if (val
== TYPE_FIELD_BITPOS (type
, i
))
357 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
361 print_longest (stream
, 'd', 0, val
);
368 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
371 /* FIXME, we should consider, at least for ANSI C language, eliminating
372 the distinction made between FUNCs and POINTERs to FUNCs. */
373 fprintf_filtered (stream
, "{");
374 type_print (type
, "", stream
, -1);
375 fprintf_filtered (stream
, "} ");
376 /* Try to print what function it points to, and its address. */
377 print_address_demangle (address
, stream
, demangle
);
381 format
= format
? format
: output_format
;
383 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
386 val
= unpack_long (type
, valaddr
+ embedded_offset
);
388 fputs_filtered ("false", stream
);
390 fputs_filtered ("true", stream
);
393 fputs_filtered ("true (", stream
);
394 fprintf_filtered (stream
, "%ld)", (long int) val
);
399 case TYPE_CODE_RANGE
:
400 /* FIXME: create_range_type does not set the unsigned bit in a
401 range type (I think it probably should copy it from the target
402 type), so we won't print values which are too large to
403 fit in a signed integer correctly. */
404 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
405 print with the target type, though, because the size of our type
406 and the target type might differ). */
410 format
= format
? format
: output_format
;
413 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
417 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
422 format
= format
? format
: output_format
;
425 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
429 val
= unpack_long (type
, valaddr
+ embedded_offset
);
430 if (TYPE_UNSIGNED (type
))
431 fprintf_filtered (stream
, "%u", (unsigned int) val
);
433 fprintf_filtered (stream
, "%d", (int) val
);
434 fputs_filtered (" ", stream
);
435 LA_PRINT_CHAR ((unsigned char) val
, stream
);
442 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
446 print_floating (valaddr
+ embedded_offset
, type
, stream
);
450 case TYPE_CODE_BITSTRING
:
452 elttype
= TYPE_INDEX_TYPE (type
);
453 CHECK_TYPEDEF (elttype
);
454 if (TYPE_STUB (elttype
))
456 fprintf_filtered (stream
, "<incomplete type>");
462 struct type
*range
= elttype
;
463 LONGEST low_bound
, high_bound
;
465 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
469 fputs_filtered ("B'", stream
);
471 fputs_filtered ("[", stream
);
473 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
477 fputs_filtered ("<error value>", stream
);
481 for (i
= low_bound
; i
<= high_bound
; i
++)
483 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
487 goto maybe_bad_bstring
;
490 fprintf_filtered (stream
, "%d", element
);
494 fputs_filtered (", ", stream
);
495 print_type_scalar (range
, i
, stream
);
498 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
501 fputs_filtered ("..", stream
);
502 while (i
+ 1 <= high_bound
503 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
505 print_type_scalar (range
, j
, stream
);
511 fputs_filtered ("'", stream
);
513 fputs_filtered ("]", stream
);
518 fprintf_filtered (stream
, "void");
521 case TYPE_CODE_ERROR
:
522 fprintf_filtered (stream
, "<error type>");
525 case TYPE_CODE_UNDEF
:
526 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
527 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
528 and no complete type for struct foo in that file. */
529 fprintf_filtered (stream
, "<incomplete type>");
533 error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type
));
540 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
541 enum val_prettyprint pretty
)
543 struct type
*type
= VALUE_TYPE (val
);
545 /* If it is a pointer, indicate what it points to.
547 Print type also if it is a reference.
549 Object pascal: if it is a member pointer, we will take care
550 of that when we print it. */
551 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
552 TYPE_CODE (type
) == TYPE_CODE_REF
)
554 /* Hack: remove (char *) for char strings. Their
555 type is indicated by the quoted string anyway. */
556 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
557 TYPE_NAME (type
) == NULL
&&
558 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
&&
559 STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char"))
565 fprintf_filtered (stream
, "(");
566 type_print (type
, "", stream
, -1);
567 fprintf_filtered (stream
, ") ");
570 return val_print (type
, VALUE_CONTENTS (val
), VALUE_EMBEDDED_OFFSET (val
),
571 VALUE_ADDRESS (val
) + VALUE_OFFSET (val
),
572 stream
, format
, 1, 0, pretty
);
576 /******************************************************************************
577 Inserted from cp-valprint
578 ******************************************************************************/
580 extern int vtblprint
; /* Controls printing of vtbl's */
581 extern int objectprint
; /* Controls looking up an object's derived type
582 using what we find in its vtables. */
583 static int pascal_static_field_print
; /* Controls printing of static fields. */
585 static struct obstack dont_print_vb_obstack
;
586 static struct obstack dont_print_statmem_obstack
;
588 static void pascal_object_print_static_field (struct type
*, struct value
*,
589 struct ui_file
*, int, int,
590 enum val_prettyprint
);
593 pascal_object_print_value (struct type
*, char *, CORE_ADDR
, struct ui_file
*,
594 int, int, enum val_prettyprint
, struct type
**);
597 pascal_object_print_class_method (char *valaddr
, struct type
*type
,
598 struct ui_file
*stream
)
601 struct fn_field
*f
= NULL
;
610 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
612 domain
= TYPE_DOMAIN_TYPE (target_type
);
613 if (domain
== (struct type
*) NULL
)
615 fprintf_filtered (stream
, "<unknown>");
618 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
619 if (METHOD_PTR_IS_VIRTUAL (addr
))
621 offset
= METHOD_PTR_TO_VOFFSET (addr
);
622 len
= TYPE_NFN_FIELDS (domain
);
623 for (i
= 0; i
< len
; i
++)
625 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
626 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
628 for (j
= 0; j
< len2
; j
++)
631 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
633 if (TYPE_FN_FIELD_STUB (f
, j
))
634 check_stub_method (domain
, i
, j
);
643 sym
= find_pc_function (addr
);
646 error ("invalid pointer to member function");
648 len
= TYPE_NFN_FIELDS (domain
);
649 for (i
= 0; i
< len
; i
++)
651 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
652 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
654 for (j
= 0; j
< len2
; j
++)
657 if (TYPE_FN_FIELD_STUB (f
, j
))
658 check_stub_method (domain
, i
, j
);
659 if (STREQ (SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
669 char *demangled_name
;
671 fprintf_filtered (stream
, "&");
672 fprintf_filtered (stream
, kind
);
673 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
674 DMGL_ANSI
| DMGL_PARAMS
);
675 if (demangled_name
== NULL
)
676 fprintf_filtered (stream
, "<badly mangled name %s>",
677 TYPE_FN_FIELD_PHYSNAME (f
, j
));
680 fputs_filtered (demangled_name
, stream
);
681 xfree (demangled_name
);
686 fprintf_filtered (stream
, "(");
687 type_print (type
, "", stream
, -1);
688 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
692 /* It was changed to this after 2.4.5. */
693 const char pascal_vtbl_ptr_name
[] =
694 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
696 /* Return truth value for assertion that TYPE is of the type
697 "pointer to virtual function". */
700 pascal_object_is_vtbl_ptr_type (struct type
*type
)
702 char *typename
= type_name_no_tag (type
);
704 return (typename
!= NULL
705 && (STREQ (typename
, pascal_vtbl_ptr_name
)));
708 /* Return truth value for the assertion that TYPE is of the type
709 "pointer to virtual function table". */
712 pascal_object_is_vtbl_member (struct type
*type
)
714 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
716 type
= TYPE_TARGET_TYPE (type
);
717 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
719 type
= TYPE_TARGET_TYPE (type
);
720 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
721 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
723 /* Virtual functions tables are full of pointers
724 to virtual functions. */
725 return pascal_object_is_vtbl_ptr_type (type
);
732 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
733 print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
735 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
736 same meanings as in pascal_object_print_value and c_val_print.
738 DONT_PRINT is an array of baseclass types that we
739 should not print, or zero if called from top level. */
742 pascal_object_print_value_fields (struct type
*type
, char *valaddr
,
743 CORE_ADDR address
, struct ui_file
*stream
,
744 int format
, int recurse
,
745 enum val_prettyprint pretty
,
746 struct type
**dont_print_vb
,
747 int dont_print_statmem
)
749 int i
, len
, n_baseclasses
;
750 struct obstack tmp_obstack
;
751 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
753 CHECK_TYPEDEF (type
);
755 fprintf_filtered (stream
, "{");
756 len
= TYPE_NFIELDS (type
);
757 n_baseclasses
= TYPE_N_BASECLASSES (type
);
759 /* Print out baseclasses such that we don't print
760 duplicates of virtual baseclasses. */
761 if (n_baseclasses
> 0)
762 pascal_object_print_value (type
, valaddr
, address
, stream
,
763 format
, recurse
+ 1, pretty
, dont_print_vb
);
765 if (!len
&& n_baseclasses
== 1)
766 fprintf_filtered (stream
, "<No data fields>");
769 extern int inspect_it
;
772 if (dont_print_statmem
== 0)
774 /* If we're at top level, carve out a completely fresh
775 chunk of the obstack and use that until this particular
776 invocation returns. */
777 tmp_obstack
= dont_print_statmem_obstack
;
778 obstack_finish (&dont_print_statmem_obstack
);
781 for (i
= n_baseclasses
; i
< len
; i
++)
783 /* If requested, skip printing of static fields. */
784 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
787 fprintf_filtered (stream
, ", ");
788 else if (n_baseclasses
> 0)
792 fprintf_filtered (stream
, "\n");
793 print_spaces_filtered (2 + 2 * recurse
, stream
);
794 fputs_filtered ("members of ", stream
);
795 fputs_filtered (type_name_no_tag (type
), stream
);
796 fputs_filtered (": ", stream
);
803 fprintf_filtered (stream
, "\n");
804 print_spaces_filtered (2 + 2 * recurse
, stream
);
808 wrap_here (n_spaces (2 + 2 * recurse
));
812 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
813 fputs_filtered ("\"( ptr \"", stream
);
815 fputs_filtered ("\"( nodef \"", stream
);
816 if (TYPE_FIELD_STATIC (type
, i
))
817 fputs_filtered ("static ", stream
);
818 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
820 DMGL_PARAMS
| DMGL_ANSI
);
821 fputs_filtered ("\" \"", stream
);
822 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
824 DMGL_PARAMS
| DMGL_ANSI
);
825 fputs_filtered ("\") \"", stream
);
829 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
831 if (TYPE_FIELD_STATIC (type
, i
))
832 fputs_filtered ("static ", stream
);
833 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
835 DMGL_PARAMS
| DMGL_ANSI
);
836 annotate_field_name_end ();
837 fputs_filtered (" = ", stream
);
838 annotate_field_value ();
841 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
845 /* Bitfields require special handling, especially due to byte
847 if (TYPE_FIELD_IGNORE (type
, i
))
849 fputs_filtered ("<optimized out or zero length>", stream
);
853 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
854 unpack_field_as_long (type
, valaddr
, i
));
856 val_print (TYPE_FIELD_TYPE (type
, i
), VALUE_CONTENTS (v
), 0, 0,
857 stream
, format
, 0, recurse
+ 1, pretty
);
862 if (TYPE_FIELD_IGNORE (type
, i
))
864 fputs_filtered ("<optimized out or zero length>", stream
);
866 else if (TYPE_FIELD_STATIC (type
, i
))
868 /* struct value *v = value_static_field (type, i); v4.17 specific */
870 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
871 unpack_field_as_long (type
, valaddr
, i
));
874 fputs_filtered ("<optimized out>", stream
);
876 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
877 stream
, format
, recurse
+ 1,
882 /* val_print (TYPE_FIELD_TYPE (type, i),
883 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
884 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
885 stream, format, 0, recurse + 1, pretty); */
886 val_print (TYPE_FIELD_TYPE (type
, i
),
887 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
888 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
889 stream
, format
, 0, recurse
+ 1, pretty
);
892 annotate_field_end ();
895 if (dont_print_statmem
== 0)
897 /* Free the space used to deal with the printing
898 of the members from top level. */
899 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
900 dont_print_statmem_obstack
= tmp_obstack
;
905 fprintf_filtered (stream
, "\n");
906 print_spaces_filtered (2 * recurse
, stream
);
909 fprintf_filtered (stream
, "}");
912 /* Special val_print routine to avoid printing multiple copies of virtual
916 pascal_object_print_value (struct type
*type
, char *valaddr
, CORE_ADDR address
,
917 struct ui_file
*stream
, int format
, int recurse
,
918 enum val_prettyprint pretty
,
919 struct type
**dont_print_vb
)
921 struct obstack tmp_obstack
;
922 struct type
**last_dont_print
923 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
924 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
926 if (dont_print_vb
== 0)
928 /* If we're at top level, carve out a completely fresh
929 chunk of the obstack and use that until this particular
930 invocation returns. */
931 tmp_obstack
= dont_print_vb_obstack
;
932 /* Bump up the high-water mark. Now alpha is omega. */
933 obstack_finish (&dont_print_vb_obstack
);
936 for (i
= 0; i
< n_baseclasses
; i
++)
939 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
940 char *basename
= TYPE_NAME (baseclass
);
943 if (BASETYPE_VIA_VIRTUAL (type
, i
))
945 struct type
**first_dont_print
946 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
948 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
952 if (baseclass
== first_dont_print
[j
])
955 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
958 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
962 fprintf_filtered (stream
, "\n");
963 print_spaces_filtered (2 * recurse
, stream
);
965 fputs_filtered ("<", stream
);
966 /* Not sure what the best notation is in the case where there is no
969 fputs_filtered (basename
? basename
: "", stream
);
970 fputs_filtered ("> = ", stream
);
972 /* The virtual base class pointer might have been clobbered by the
973 user program. Make sure that it still points to a valid memory
976 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
978 /* FIXME (alloc): not safe is baseclass is really really big. */
979 base_valaddr
= (char *) alloca (TYPE_LENGTH (baseclass
));
980 if (target_read_memory (address
+ boffset
, base_valaddr
,
981 TYPE_LENGTH (baseclass
)) != 0)
985 base_valaddr
= valaddr
+ boffset
;
988 fprintf_filtered (stream
, "<invalid address>");
990 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
991 stream
, format
, recurse
, pretty
,
992 (struct type
**) obstack_base (&dont_print_vb_obstack
),
994 fputs_filtered (", ", stream
);
1000 if (dont_print_vb
== 0)
1002 /* Free the space used to deal with the printing
1003 of this type from top level. */
1004 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
1005 /* Reset watermark so that we can continue protecting
1006 ourselves from whatever we were protecting ourselves. */
1007 dont_print_vb_obstack
= tmp_obstack
;
1011 /* Print value of a static member.
1012 To avoid infinite recursion when printing a class that contains
1013 a static instance of the class, we keep the addresses of all printed
1014 static member classes in an obstack and refuse to print them more
1017 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1018 have the same meanings as in c_val_print. */
1021 pascal_object_print_static_field (struct type
*type
, struct value
*val
,
1022 struct ui_file
*stream
, int format
,
1023 int recurse
, enum val_prettyprint pretty
)
1025 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1027 CORE_ADDR
*first_dont_print
;
1031 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1032 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1037 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1039 fputs_filtered ("<same as static member of an already seen type>",
1045 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1046 sizeof (CORE_ADDR
));
1048 CHECK_TYPEDEF (type
);
1049 pascal_object_print_value_fields (type
, VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
1050 stream
, format
, recurse
, pretty
, NULL
, 1);
1053 val_print (type
, VALUE_CONTENTS (val
), 0, VALUE_ADDRESS (val
),
1054 stream
, format
, 0, recurse
, pretty
);
1058 pascal_object_print_class_member (char *valaddr
, struct type
*domain
,
1059 struct ui_file
*stream
, char *prefix
)
1062 /* VAL is a byte offset into the structure type DOMAIN.
1063 Find the name of the field for that offset and
1067 register unsigned int i
;
1068 unsigned len
= TYPE_NFIELDS (domain
);
1069 /* @@ Make VAL into bit offset */
1070 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1071 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1073 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1077 if (val
< bitpos
&& i
!= 0)
1079 /* Somehow pointing into a field. */
1081 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1092 fprintf_filtered (stream
, prefix
);
1093 name
= type_name_no_tag (domain
);
1095 fputs_filtered (name
, stream
);
1097 pascal_type_print_base (domain
, stream
, 0, 0);
1098 fprintf_filtered (stream
, "::");
1099 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1101 fprintf_filtered (stream
, " + %d bytes", extra
);
1103 fprintf_filtered (stream
, " (offset in bits)");
1106 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1111 _initialize_pascal_valprint (void)
1114 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1115 (char *) &pascal_static_field_print
,
1116 "Set printing of pascal static members.",
1119 /* Turn on printing of static fields. */
1120 pascal_static_field_print
= 1;