1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright 2000, 2001, 2003, 2005 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 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
, const bfd_byte
*valaddr
,
60 int embedded_offset
, CORE_ADDR address
,
61 struct ui_file
*stream
, int format
, int deref_ref
,
62 int recurse
, enum val_prettyprint pretty
)
64 unsigned int i
= 0; /* Number of characters printed */
68 int length_pos
, length_size
, string_pos
;
74 switch (TYPE_CODE (type
))
77 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
79 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
80 eltlen
= TYPE_LENGTH (elttype
);
81 len
= TYPE_LENGTH (type
) / eltlen
;
82 if (prettyprint_arrays
)
84 print_spaces_filtered (2 + 2 * recurse
, stream
);
86 /* For an array of chars, print with string syntax. */
88 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
89 || ((current_language
->la_language
== language_m2
)
90 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
91 && (format
== 0 || format
== 's'))
93 /* If requested, look for the first null char and only print
95 if (stop_print_at_null
)
97 unsigned int temp_len
;
99 /* Look for a NULL char. */
101 (valaddr
+ embedded_offset
)[temp_len
]
102 && temp_len
< len
&& temp_len
< print_max
;
107 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
112 fprintf_filtered (stream
, "{");
113 /* If this is a virtual function table, print the 0th
114 entry specially, and the rest of the members normally. */
115 if (pascal_object_is_vtbl_ptr_type (elttype
))
118 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
124 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
125 format
, deref_ref
, recurse
, pretty
, i
);
126 fprintf_filtered (stream
, "}");
130 /* Array of unspecified length: treat like pointer to first elt. */
132 goto print_unpacked_pointer
;
135 if (format
&& format
!= 's')
137 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
140 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
142 /* Print the unmangled name if desired. */
143 /* Print vtable entry - we only get here if we ARE using
144 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
145 /* Extract the address, assume that it is unsigned. */
146 print_address_demangle (extract_unsigned_integer (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
150 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
151 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
153 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
155 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
157 pascal_object_print_class_member (valaddr
+ embedded_offset
,
158 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
163 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
164 print_unpacked_pointer
:
165 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
167 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
169 /* Try to print what function it points to. */
170 print_address_demangle (addr
, stream
, demangle
);
171 /* Return value is irrelevant except for string pointers. */
175 if (addressprint
&& format
!= 's')
177 print_address_numeric (addr
, 1, stream
);
180 /* For a pointer to char or unsigned char, also print the string
181 pointed to, unless pointer is null. */
182 if (TYPE_LENGTH (elttype
) == 1
183 && TYPE_CODE (elttype
) == TYPE_CODE_INT
184 && (format
== 0 || format
== 's')
187 /* no wide string yet */
188 i
= val_print_string (addr
, -1, 1, stream
);
190 /* also for pointers to pascal strings */
191 /* Note: this is Free Pascal specific:
192 as GDB does not recognize stabs pascal strings
193 Pascal strings are mapped to records
194 with lowercase names PM */
195 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
196 &string_pos
, &char_size
, NULL
)
199 ULONGEST string_length
;
201 buffer
= xmalloc (length_size
);
202 read_memory (addr
+ length_pos
, buffer
, length_size
);
203 string_length
= extract_unsigned_integer (buffer
, length_size
);
205 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
207 else if (pascal_object_is_vtbl_member (type
))
209 /* print vtbl's nicely */
210 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
212 struct minimal_symbol
*msymbol
=
213 lookup_minimal_symbol_by_pc (vt_address
);
214 if ((msymbol
!= NULL
)
215 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
217 fputs_filtered (" <", stream
);
218 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
219 fputs_filtered (">", stream
);
221 if (vt_address
&& vtblprint
)
223 struct value
*vt_val
;
224 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
, NULL
);
235 wtype
= SYMBOL_TYPE (wsym
);
239 wtype
= TYPE_TARGET_TYPE (type
);
241 vt_val
= value_at (wtype
, vt_address
);
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
));
294 val_print (value_type (deref_val
),
295 value_contents (deref_val
), 0,
296 VALUE_ADDRESS (deref_val
), stream
, format
,
297 deref_ref
, recurse
+ 1, pretty
);
300 fputs_filtered ("???", stream
);
304 case TYPE_CODE_UNION
:
305 if (recurse
&& !unionprint
)
307 fprintf_filtered (stream
, "{...}");
311 case TYPE_CODE_STRUCT
:
312 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
314 /* Print the unmangled name if desired. */
315 /* Print vtable entry - we only get here if NOT using
316 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
317 /* Extract the address, assume that it is unsigned. */
318 print_address_demangle
319 (extract_unsigned_integer (valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
320 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
325 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
326 &string_pos
, &char_size
, NULL
))
328 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
329 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
332 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
333 recurse
, pretty
, NULL
, 0);
340 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
343 len
= TYPE_NFIELDS (type
);
344 val
= unpack_long (type
, valaddr
+ embedded_offset
);
345 for (i
= 0; i
< len
; i
++)
348 if (val
== TYPE_FIELD_BITPOS (type
, i
))
355 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
359 print_longest (stream
, 'd', 0, val
);
366 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
369 /* FIXME, we should consider, at least for ANSI C language, eliminating
370 the distinction made between FUNCs and POINTERs to FUNCs. */
371 fprintf_filtered (stream
, "{");
372 type_print (type
, "", stream
, -1);
373 fprintf_filtered (stream
, "} ");
374 /* Try to print what function it points to, and its address. */
375 print_address_demangle (address
, stream
, demangle
);
379 format
= format
? format
: output_format
;
381 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
384 val
= unpack_long (type
, valaddr
+ embedded_offset
);
386 fputs_filtered ("false", stream
);
388 fputs_filtered ("true", stream
);
391 fputs_filtered ("true (", stream
);
392 fprintf_filtered (stream
, "%ld)", (long int) val
);
397 case TYPE_CODE_RANGE
:
398 /* FIXME: create_range_type does not set the unsigned bit in a
399 range type (I think it probably should copy it from the target
400 type), so we won't print values which are too large to
401 fit in a signed integer correctly. */
402 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
403 print with the target type, though, because the size of our type
404 and the target type might differ). */
408 format
= format
? format
: output_format
;
411 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
415 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
420 format
= format
? format
: output_format
;
423 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
427 val
= unpack_long (type
, valaddr
+ embedded_offset
);
428 if (TYPE_UNSIGNED (type
))
429 fprintf_filtered (stream
, "%u", (unsigned int) val
);
431 fprintf_filtered (stream
, "%d", (int) val
);
432 fputs_filtered (" ", stream
);
433 LA_PRINT_CHAR ((unsigned char) val
, stream
);
440 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
444 print_floating (valaddr
+ embedded_offset
, type
, stream
);
448 case TYPE_CODE_BITSTRING
:
450 elttype
= TYPE_INDEX_TYPE (type
);
451 CHECK_TYPEDEF (elttype
);
452 if (TYPE_STUB (elttype
))
454 fprintf_filtered (stream
, "<incomplete type>");
460 struct type
*range
= elttype
;
461 LONGEST low_bound
, high_bound
;
463 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
467 fputs_filtered ("B'", stream
);
469 fputs_filtered ("[", stream
);
471 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
475 fputs_filtered ("<error value>", stream
);
479 for (i
= low_bound
; i
<= high_bound
; i
++)
481 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
485 goto maybe_bad_bstring
;
488 fprintf_filtered (stream
, "%d", element
);
492 fputs_filtered (", ", stream
);
493 print_type_scalar (range
, i
, stream
);
496 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
499 fputs_filtered ("..", stream
);
500 while (i
+ 1 <= high_bound
501 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
503 print_type_scalar (range
, j
, stream
);
509 fputs_filtered ("'", stream
);
511 fputs_filtered ("]", stream
);
516 fprintf_filtered (stream
, "void");
519 case TYPE_CODE_ERROR
:
520 fprintf_filtered (stream
, "<error type>");
523 case TYPE_CODE_UNDEF
:
524 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
525 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
526 and no complete type for struct foo in that file. */
527 fprintf_filtered (stream
, "<incomplete type>");
531 error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type
));
538 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
539 enum val_prettyprint pretty
)
541 struct type
*type
= value_type (val
);
543 /* If it is a pointer, indicate what it points to.
545 Print type also if it is a reference.
547 Object pascal: if it is a member pointer, we will take care
548 of that when we print it. */
549 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
550 TYPE_CODE (type
) == TYPE_CODE_REF
)
552 /* Hack: remove (char *) for char strings. Their
553 type is indicated by the quoted string anyway. */
554 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
555 TYPE_NAME (type
) == NULL
&&
556 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
557 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
563 fprintf_filtered (stream
, "(");
564 type_print (type
, "", stream
, -1);
565 fprintf_filtered (stream
, ") ");
568 return val_print (type
, value_contents (val
), value_embedded_offset (val
),
569 VALUE_ADDRESS (val
) + value_offset (val
),
570 stream
, format
, 1, 0, pretty
);
574 /******************************************************************************
575 Inserted from cp-valprint
576 ******************************************************************************/
578 extern int vtblprint
; /* Controls printing of vtbl's */
579 extern int objectprint
; /* Controls looking up an object's derived type
580 using what we find in its vtables. */
581 static int pascal_static_field_print
; /* Controls printing of static fields. */
583 static struct obstack dont_print_vb_obstack
;
584 static struct obstack dont_print_statmem_obstack
;
586 static void pascal_object_print_static_field (struct type
*, struct value
*,
587 struct ui_file
*, int, int,
588 enum val_prettyprint
);
590 static void pascal_object_print_value (struct type
*, const bfd_byte
*,
591 CORE_ADDR
, struct ui_file
*,
592 int, int, enum val_prettyprint
,
596 pascal_object_print_class_method (const bfd_byte
*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 (DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
662 char *demangled_name
;
664 fprintf_filtered (stream
, "&");
665 fputs_filtered (kind
, stream
);
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 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
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
726 c_val_print to print out a structure's fields:
727 pascal_object_print_value_fields and pascal_object_print_value.
729 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
730 same meanings as in pascal_object_print_value and c_val_print.
732 DONT_PRINT is an array of baseclass types that we
733 should not print, or zero if called from top level. */
736 pascal_object_print_value_fields (struct type
*type
, const bfd_byte
*valaddr
,
737 CORE_ADDR address
, struct ui_file
*stream
,
738 int format
, int recurse
,
739 enum val_prettyprint pretty
,
740 struct type
**dont_print_vb
,
741 int dont_print_statmem
)
743 int i
, len
, n_baseclasses
;
744 struct obstack tmp_obstack
;
745 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
747 CHECK_TYPEDEF (type
);
749 fprintf_filtered (stream
, "{");
750 len
= TYPE_NFIELDS (type
);
751 n_baseclasses
= TYPE_N_BASECLASSES (type
);
753 /* Print out baseclasses such that we don't print
754 duplicates of virtual baseclasses. */
755 if (n_baseclasses
> 0)
756 pascal_object_print_value (type
, valaddr
, address
, stream
,
757 format
, recurse
+ 1, pretty
, dont_print_vb
);
759 if (!len
&& n_baseclasses
== 1)
760 fprintf_filtered (stream
, "<No data fields>");
765 if (dont_print_statmem
== 0)
767 /* If we're at top level, carve out a completely fresh
768 chunk of the obstack and use that until this particular
769 invocation returns. */
770 tmp_obstack
= dont_print_statmem_obstack
;
771 obstack_finish (&dont_print_statmem_obstack
);
774 for (i
= n_baseclasses
; i
< len
; i
++)
776 /* If requested, skip printing of static fields. */
777 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
780 fprintf_filtered (stream
, ", ");
781 else if (n_baseclasses
> 0)
785 fprintf_filtered (stream
, "\n");
786 print_spaces_filtered (2 + 2 * recurse
, stream
);
787 fputs_filtered ("members of ", stream
);
788 fputs_filtered (type_name_no_tag (type
), stream
);
789 fputs_filtered (": ", stream
);
796 fprintf_filtered (stream
, "\n");
797 print_spaces_filtered (2 + 2 * recurse
, stream
);
801 wrap_here (n_spaces (2 + 2 * recurse
));
805 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
806 fputs_filtered ("\"( ptr \"", stream
);
808 fputs_filtered ("\"( nodef \"", stream
);
809 if (TYPE_FIELD_STATIC (type
, i
))
810 fputs_filtered ("static ", stream
);
811 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
813 DMGL_PARAMS
| DMGL_ANSI
);
814 fputs_filtered ("\" \"", stream
);
815 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
817 DMGL_PARAMS
| DMGL_ANSI
);
818 fputs_filtered ("\") \"", stream
);
822 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
824 if (TYPE_FIELD_STATIC (type
, i
))
825 fputs_filtered ("static ", stream
);
826 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
828 DMGL_PARAMS
| DMGL_ANSI
);
829 annotate_field_name_end ();
830 fputs_filtered (" = ", stream
);
831 annotate_field_value ();
834 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
838 /* Bitfields require special handling, especially due to byte
840 if (TYPE_FIELD_IGNORE (type
, i
))
842 fputs_filtered ("<optimized out or zero length>", stream
);
846 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
847 unpack_field_as_long (type
, valaddr
, i
));
849 val_print (TYPE_FIELD_TYPE (type
, i
), value_contents (v
), 0, 0,
850 stream
, format
, 0, recurse
+ 1, pretty
);
855 if (TYPE_FIELD_IGNORE (type
, i
))
857 fputs_filtered ("<optimized out or zero length>", stream
);
859 else if (TYPE_FIELD_STATIC (type
, i
))
861 /* struct value *v = value_static_field (type, i); v4.17 specific */
863 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
864 unpack_field_as_long (type
, valaddr
, i
));
867 fputs_filtered ("<optimized out>", stream
);
869 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
870 stream
, format
, recurse
+ 1,
875 /* val_print (TYPE_FIELD_TYPE (type, i),
876 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
877 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
878 stream, format, 0, recurse + 1, pretty); */
879 val_print (TYPE_FIELD_TYPE (type
, i
),
880 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
881 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
882 stream
, format
, 0, recurse
+ 1, pretty
);
885 annotate_field_end ();
888 if (dont_print_statmem
== 0)
890 /* Free the space used to deal with the printing
891 of the members from top level. */
892 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
893 dont_print_statmem_obstack
= tmp_obstack
;
898 fprintf_filtered (stream
, "\n");
899 print_spaces_filtered (2 * recurse
, stream
);
902 fprintf_filtered (stream
, "}");
905 /* Special val_print routine to avoid printing multiple copies of virtual
909 pascal_object_print_value (struct type
*type
, const bfd_byte
*valaddr
,
910 CORE_ADDR address
, struct ui_file
*stream
,
911 int format
, int recurse
,
912 enum val_prettyprint pretty
,
913 struct type
**dont_print_vb
)
915 struct obstack tmp_obstack
;
916 struct type
**last_dont_print
917 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
918 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
920 if (dont_print_vb
== 0)
922 /* If we're at top level, carve out a completely fresh
923 chunk of the obstack and use that until this particular
924 invocation returns. */
925 tmp_obstack
= dont_print_vb_obstack
;
926 /* Bump up the high-water mark. Now alpha is omega. */
927 obstack_finish (&dont_print_vb_obstack
);
930 for (i
= 0; i
< n_baseclasses
; i
++)
933 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
934 char *basename
= TYPE_NAME (baseclass
);
935 const bfd_byte
*base_valaddr
;
937 if (BASETYPE_VIA_VIRTUAL (type
, i
))
939 struct type
**first_dont_print
940 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
942 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
946 if (baseclass
== first_dont_print
[j
])
949 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
952 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
956 fprintf_filtered (stream
, "\n");
957 print_spaces_filtered (2 * recurse
, stream
);
959 fputs_filtered ("<", stream
);
960 /* Not sure what the best notation is in the case where there is no
963 fputs_filtered (basename
? basename
: "", stream
);
964 fputs_filtered ("> = ", stream
);
966 /* The virtual base class pointer might have been clobbered by the
967 user program. Make sure that it still points to a valid memory
970 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
972 /* FIXME (alloc): not safe is baseclass is really really big. */
973 bfd_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
975 if (target_read_memory (address
+ boffset
, buf
,
976 TYPE_LENGTH (baseclass
)) != 0)
980 base_valaddr
= valaddr
+ boffset
;
983 fprintf_filtered (stream
, "<invalid address>");
985 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
986 stream
, format
, recurse
, pretty
,
987 (struct type
**) obstack_base (&dont_print_vb_obstack
),
989 fputs_filtered (", ", stream
);
995 if (dont_print_vb
== 0)
997 /* Free the space used to deal with the printing
998 of this type from top level. */
999 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
1000 /* Reset watermark so that we can continue protecting
1001 ourselves from whatever we were protecting ourselves. */
1002 dont_print_vb_obstack
= tmp_obstack
;
1006 /* Print value of a static member.
1007 To avoid infinite recursion when printing a class that contains
1008 a static instance of the class, we keep the addresses of all printed
1009 static member classes in an obstack and refuse to print them more
1012 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1013 have the same meanings as in c_val_print. */
1016 pascal_object_print_static_field (struct type
*type
, struct value
*val
,
1017 struct ui_file
*stream
, int format
,
1018 int recurse
, enum val_prettyprint pretty
)
1020 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1022 CORE_ADDR
*first_dont_print
;
1026 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1027 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1032 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1034 fputs_filtered ("<same as static member of an already seen type>",
1040 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1041 sizeof (CORE_ADDR
));
1043 CHECK_TYPEDEF (type
);
1044 pascal_object_print_value_fields (type
, value_contents (val
), VALUE_ADDRESS (val
),
1045 stream
, format
, recurse
, pretty
, NULL
, 1);
1048 val_print (type
, value_contents (val
), 0, VALUE_ADDRESS (val
),
1049 stream
, format
, 0, recurse
, pretty
);
1053 pascal_object_print_class_member (const bfd_byte
*valaddr
, struct type
*domain
,
1054 struct ui_file
*stream
, char *prefix
)
1057 /* VAL is a byte offset into the structure type DOMAIN.
1058 Find the name of the field for that offset and
1063 unsigned len
= TYPE_NFIELDS (domain
);
1064 /* @@ Make VAL into bit offset */
1065 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1066 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1068 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1072 if (val
< bitpos
&& i
!= 0)
1074 /* Somehow pointing into a field. */
1076 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1087 fputs_filtered (prefix
, stream
);
1088 name
= type_name_no_tag (domain
);
1090 fputs_filtered (name
, stream
);
1092 pascal_type_print_base (domain
, stream
, 0, 0);
1093 fprintf_filtered (stream
, "::");
1094 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1096 fprintf_filtered (stream
, " + %d bytes", extra
);
1098 fprintf_filtered (stream
, " (offset in bits)");
1101 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1104 extern initialize_file_ftype _initialize_pascal_valprint
; /* -Wmissing-prototypes */
1107 _initialize_pascal_valprint (void)
1109 deprecated_add_show_from_set
1110 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1111 (char *) &pascal_static_field_print
,
1112 "Set printing of pascal static members.",
1115 /* Turn on printing of static fields. */
1116 pascal_static_field_print
= 1;