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 */
27 #include "expression.h"
42 /* Print data of type TYPE located at VALADDR (within GDB), which came from
43 the inferior at address ADDRESS, onto stdio stream STREAM according to
44 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
47 If the data are a string pointer, returns the number of string characters
50 If DEREF_REF is nonzero, then dereference references, otherwise just print
53 The PRETTY parameter controls prettyprinting. */
57 pascal_val_print (type
, valaddr
, embedded_offset
, address
, stream
, format
, deref_ref
, recurse
,
63 struct ui_file
*stream
;
67 enum val_prettyprint pretty
;
69 register unsigned int i
= 0; /* Number of characters printed */
77 switch (TYPE_CODE (type
))
80 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
82 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
83 eltlen
= TYPE_LENGTH (elttype
);
84 len
= TYPE_LENGTH (type
) / eltlen
;
85 if (prettyprint_arrays
)
87 print_spaces_filtered (2 + 2 * recurse
, stream
);
89 /* For an array of chars, print with string syntax. */
91 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
92 || ((current_language
->la_language
== language_m2
)
93 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
94 && (format
== 0 || format
== 's'))
96 /* If requested, look for the first null char and only print
98 if (stop_print_at_null
)
100 unsigned int temp_len
;
102 /* Look for a NULL char. */
104 (valaddr
+ embedded_offset
)[temp_len
]
105 && temp_len
< len
&& temp_len
< print_max
;
110 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
115 fprintf_filtered (stream
, "{");
116 /* If this is a virtual function table, print the 0th
117 entry specially, and the rest of the members normally. */
118 if (pascal_object_is_vtbl_ptr_type (elttype
))
121 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
127 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
128 format
, deref_ref
, recurse
, pretty
, i
);
129 fprintf_filtered (stream
, "}");
133 /* Array of unspecified length: treat like pointer to first elt. */
135 goto print_unpacked_pointer
;
138 if (format
&& format
!= 's')
140 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
143 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
145 /* Print the unmangled name if desired. */
146 /* Print vtable entry - we only get here if we ARE using
147 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
148 print_address_demangle (extract_address (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
152 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
153 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
155 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
157 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
159 pascal_object_print_class_member (valaddr
+ embedded_offset
,
160 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
165 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
166 print_unpacked_pointer
:
167 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
169 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
171 /* Try to print what function it points to. */
172 print_address_demangle (addr
, stream
, demangle
);
173 /* Return value is irrelevant except for string pointers. */
177 if (addressprint
&& format
!= 's')
179 print_address_numeric (addr
, 1, stream
);
182 /* For a pointer to char or unsigned char, also print the string
183 pointed to, unless pointer is null. */
184 if (TYPE_LENGTH (elttype
) == 1
185 && TYPE_CODE (elttype
) == TYPE_CODE_INT
186 && (format
== 0 || format
== 's')
189 /* no wide string yet */
190 i
= val_print_string (addr
, -1, 1, stream
);
192 /* also for pointers to pascal strings */
193 /* Note: this is Free Pascal specific:
194 as GDB does not recognize stabs pascal strings
195 Pascal strings are mapped to records
196 with lowercase names PM */
197 /* I don't know what GPC does :( PM */
198 if (TYPE_CODE (elttype
) == TYPE_CODE_STRUCT
&&
199 TYPE_NFIELDS (elttype
) == 2 &&
200 strcmp (TYPE_FIELDS (elttype
)[0].name
, "length") == 0 &&
201 strcmp (TYPE_FIELDS (elttype
)[1].name
, "st") == 0 &&
205 read_memory (addr
, &bytelength
, 1);
206 i
= val_print_string (addr
+ 1, bytelength
, 1, stream
);
208 else if (pascal_object_is_vtbl_member (type
))
210 /* print vtbl's nicely */
211 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
213 struct minimal_symbol
*msymbol
=
214 lookup_minimal_symbol_by_pc (vt_address
);
215 if ((msymbol
!= NULL
) &&
216 (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
218 fputs_filtered (" <", stream
);
219 fputs_filtered (SYMBOL_SOURCE_NAME (msymbol
), stream
);
220 fputs_filtered (">", stream
);
222 if (vt_address
&& vtblprint
)
225 struct symbol
*wsym
= (struct symbol
*) NULL
;
228 struct block
*block
= (struct block
*) NULL
;
232 wsym
= lookup_symbol (SYMBOL_NAME (msymbol
), block
,
233 VAR_NAMESPACE
, &is_this_fld
, &s
);
237 wtype
= SYMBOL_TYPE (wsym
);
241 wtype
= TYPE_TARGET_TYPE (type
);
243 vt_val
= value_at (wtype
, vt_address
, NULL
);
244 val_print (VALUE_TYPE (vt_val
), VALUE_CONTENTS (vt_val
), 0,
245 VALUE_ADDRESS (vt_val
), stream
, format
,
246 deref_ref
, recurse
+ 1, pretty
);
249 fprintf_filtered (stream
, "\n");
250 print_spaces_filtered (2 + 2 * recurse
, stream
);
255 /* Return number of characters printed, including the terminating
256 '\0' if we reached the end. val_print_string takes care including
257 the terminating '\0' if necessary. */
262 case TYPE_CODE_MEMBER
:
263 error ("not implemented: member type in pascal_val_print");
267 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
268 if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
270 pascal_object_print_class_member (valaddr
+ embedded_offset
,
271 TYPE_DOMAIN_TYPE (elttype
),
277 fprintf_filtered (stream
, "@");
278 print_address_numeric
279 (extract_address (valaddr
+ embedded_offset
,
280 TARGET_PTR_BIT
/ HOST_CHAR_BIT
), 1, stream
);
282 fputs_filtered (": ", stream
);
284 /* De-reference the reference. */
287 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
289 value_ptr 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 print_address_demangle (extract_address (
319 valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
320 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
325 if ((TYPE_NFIELDS (type
) == 2) &&
326 (strcmp (TYPE_FIELDS (type
)[0].name
, "length") == 0) &&
327 (strcmp (TYPE_FIELDS (type
)[1].name
, "st") == 0))
329 len
= (*(valaddr
+ embedded_offset
)) & 0xff;
330 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ 1, len
, /* width ?? */ 0, 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_FLAGS (elttype
) & TYPE_FLAG_STUB
)
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 (val
, stream
, format
, pretty
)
541 struct ui_file
*stream
;
543 enum val_prettyprint pretty
;
545 struct type
*type
= VALUE_TYPE (val
);
547 /* If it is a pointer, indicate what it points to.
549 Print type also if it is a reference.
551 Object pascal: if it is a member pointer, we will take care
552 of that when we print it. */
553 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
554 TYPE_CODE (type
) == TYPE_CODE_REF
)
556 /* Hack: remove (char *) for char strings. Their
557 type is indicated by the quoted string anyway. */
558 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
559 TYPE_NAME (type
) == NULL
&&
560 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
&&
561 STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char"))
567 fprintf_filtered (stream
, "(");
568 type_print (type
, "", stream
, -1);
569 fprintf_filtered (stream
, ") ");
572 return val_print (type
, VALUE_CONTENTS (val
), VALUE_EMBEDDED_OFFSET (val
),
573 VALUE_ADDRESS (val
) + VALUE_OFFSET (val
),
574 stream
, format
, 1, 0, pretty
);
578 /******************************************************************************
579 Inserted from cp-valprint
580 ******************************************************************************/
582 extern int vtblprint
; /* Controls printing of vtbl's */
583 extern int objectprint
; /* Controls looking up an object's derived type
584 using what we find in its vtables. */
585 static int pascal_static_field_print
; /* Controls printing of static fields. */
587 static struct obstack dont_print_vb_obstack
;
588 static struct obstack dont_print_statmem_obstack
;
591 pascal_object_print_static_field (struct type
*, value_ptr
, struct ui_file
*, int, int,
592 enum val_prettyprint
);
595 pascal_object_print_value (struct type
*, char *, CORE_ADDR
, struct ui_file
*,
596 int, int, enum val_prettyprint
, struct type
**);
599 pascal_object_print_class_method (valaddr
, type
, stream
)
602 struct ui_file
*stream
;
605 struct fn_field
*f
= NULL
;
614 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
616 domain
= TYPE_DOMAIN_TYPE (target_type
);
617 if (domain
== (struct type
*) NULL
)
619 fprintf_filtered (stream
, "<unknown>");
622 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
623 if (METHOD_PTR_IS_VIRTUAL (addr
))
625 offset
= METHOD_PTR_TO_VOFFSET (addr
);
626 len
= TYPE_NFN_FIELDS (domain
);
627 for (i
= 0; i
< len
; i
++)
629 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
630 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
632 for (j
= 0; j
< len2
; j
++)
635 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
637 if (TYPE_FN_FIELD_STUB (f
, j
))
638 check_stub_method (domain
, i
, j
);
647 sym
= find_pc_function (addr
);
650 error ("invalid pointer to member function");
652 len
= TYPE_NFN_FIELDS (domain
);
653 for (i
= 0; i
< len
; i
++)
655 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
656 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
658 for (j
= 0; j
< len2
; j
++)
661 if (TYPE_FN_FIELD_STUB (f
, j
))
662 check_stub_method (domain
, i
, j
);
663 if (STREQ (SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
673 char *demangled_name
;
675 fprintf_filtered (stream
, "&");
676 fprintf_filtered (stream
, kind
);
677 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
678 DMGL_ANSI
| DMGL_PARAMS
);
679 if (demangled_name
== NULL
)
680 fprintf_filtered (stream
, "<badly mangled name %s>",
681 TYPE_FN_FIELD_PHYSNAME (f
, j
));
684 fputs_filtered (demangled_name
, stream
);
685 free (demangled_name
);
690 fprintf_filtered (stream
, "(");
691 type_print (type
, "", stream
, -1);
692 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
696 /* It was changed to this after 2.4.5. */
697 const char pascal_vtbl_ptr_name
[] =
698 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
700 /* Return truth value for assertion that TYPE is of the type
701 "pointer to virtual function". */
704 pascal_object_is_vtbl_ptr_type (type
)
707 char *typename
= type_name_no_tag (type
);
709 return (typename
!= NULL
710 && (STREQ (typename
, pascal_vtbl_ptr_name
)));
713 /* Return truth value for the assertion that TYPE is of the type
714 "pointer to virtual function table". */
717 pascal_object_is_vtbl_member (type
)
720 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
722 type
= TYPE_TARGET_TYPE (type
);
723 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
725 type
= TYPE_TARGET_TYPE (type
);
726 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
727 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
729 /* Virtual functions tables are full of pointers
730 to virtual functions. */
731 return pascal_object_is_vtbl_ptr_type (type
);
738 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
739 print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
741 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
742 same meanings as in pascal_object_print_value and c_val_print.
744 DONT_PRINT is an array of baseclass types that we
745 should not print, or zero if called from top level. */
748 pascal_object_print_value_fields (type
, valaddr
, address
, stream
, format
, recurse
, pretty
,
749 dont_print_vb
, dont_print_statmem
)
753 struct ui_file
*stream
;
756 enum val_prettyprint pretty
;
757 struct type
**dont_print_vb
;
758 int dont_print_statmem
;
760 int i
, len
, n_baseclasses
;
761 struct obstack tmp_obstack
;
762 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
764 CHECK_TYPEDEF (type
);
766 fprintf_filtered (stream
, "{");
767 len
= TYPE_NFIELDS (type
);
768 n_baseclasses
= TYPE_N_BASECLASSES (type
);
770 /* Print out baseclasses such that we don't print
771 duplicates of virtual baseclasses. */
772 if (n_baseclasses
> 0)
773 pascal_object_print_value (type
, valaddr
, address
, stream
,
774 format
, recurse
+ 1, pretty
, dont_print_vb
);
776 if (!len
&& n_baseclasses
== 1)
777 fprintf_filtered (stream
, "<No data fields>");
780 extern int inspect_it
;
783 if (dont_print_statmem
== 0)
785 /* If we're at top level, carve out a completely fresh
786 chunk of the obstack and use that until this particular
787 invocation returns. */
788 tmp_obstack
= dont_print_statmem_obstack
;
789 obstack_finish (&dont_print_statmem_obstack
);
792 for (i
= n_baseclasses
; i
< len
; i
++)
794 /* If requested, skip printing of static fields. */
795 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
798 fprintf_filtered (stream
, ", ");
799 else if (n_baseclasses
> 0)
803 fprintf_filtered (stream
, "\n");
804 print_spaces_filtered (2 + 2 * recurse
, stream
);
805 fputs_filtered ("members of ", stream
);
806 fputs_filtered (type_name_no_tag (type
), stream
);
807 fputs_filtered (": ", stream
);
814 fprintf_filtered (stream
, "\n");
815 print_spaces_filtered (2 + 2 * recurse
, stream
);
819 wrap_here (n_spaces (2 + 2 * recurse
));
823 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
824 fputs_filtered ("\"( ptr \"", stream
);
826 fputs_filtered ("\"( nodef \"", stream
);
827 if (TYPE_FIELD_STATIC (type
, i
))
828 fputs_filtered ("static ", stream
);
829 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
831 DMGL_PARAMS
| DMGL_ANSI
);
832 fputs_filtered ("\" \"", stream
);
833 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
835 DMGL_PARAMS
| DMGL_ANSI
);
836 fputs_filtered ("\") \"", stream
);
840 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
842 if (TYPE_FIELD_STATIC (type
, i
))
843 fputs_filtered ("static ", stream
);
844 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
846 DMGL_PARAMS
| DMGL_ANSI
);
847 annotate_field_name_end ();
848 fputs_filtered (" = ", stream
);
849 annotate_field_value ();
852 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
856 /* Bitfields require special handling, especially due to byte
858 if (TYPE_FIELD_IGNORE (type
, i
))
860 fputs_filtered ("<optimized out or zero length>", stream
);
864 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
865 unpack_field_as_long (type
, valaddr
, i
));
867 val_print (TYPE_FIELD_TYPE (type
, i
), VALUE_CONTENTS (v
), 0, 0,
868 stream
, format
, 0, recurse
+ 1, pretty
);
873 if (TYPE_FIELD_IGNORE (type
, i
))
875 fputs_filtered ("<optimized out or zero length>", stream
);
877 else if (TYPE_FIELD_STATIC (type
, i
))
879 /* value_ptr v = value_static_field (type, i); v4.17 specific */
881 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
882 unpack_field_as_long (type
, valaddr
, i
));
885 fputs_filtered ("<optimized out>", stream
);
887 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
888 stream
, format
, recurse
+ 1,
893 /* val_print (TYPE_FIELD_TYPE (type, i),
894 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
895 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
896 stream, format, 0, recurse + 1, pretty); */
897 val_print (TYPE_FIELD_TYPE (type
, i
),
898 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
899 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
900 stream
, format
, 0, recurse
+ 1, pretty
);
903 annotate_field_end ();
906 if (dont_print_statmem
== 0)
908 /* Free the space used to deal with the printing
909 of the members from top level. */
910 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
911 dont_print_statmem_obstack
= tmp_obstack
;
916 fprintf_filtered (stream
, "\n");
917 print_spaces_filtered (2 * recurse
, stream
);
920 fprintf_filtered (stream
, "}");
923 /* Special val_print routine to avoid printing multiple copies of virtual
927 pascal_object_print_value (type
, valaddr
, address
, stream
, format
, recurse
, pretty
,
932 struct ui_file
*stream
;
935 enum val_prettyprint pretty
;
936 struct type
**dont_print_vb
;
938 struct obstack tmp_obstack
;
939 struct type
**last_dont_print
940 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
941 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
943 if (dont_print_vb
== 0)
945 /* If we're at top level, carve out a completely fresh
946 chunk of the obstack and use that until this particular
947 invocation returns. */
948 tmp_obstack
= dont_print_vb_obstack
;
949 /* Bump up the high-water mark. Now alpha is omega. */
950 obstack_finish (&dont_print_vb_obstack
);
953 for (i
= 0; i
< n_baseclasses
; i
++)
956 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
957 char *basename
= TYPE_NAME (baseclass
);
960 if (BASETYPE_VIA_VIRTUAL (type
, i
))
962 struct type
**first_dont_print
963 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
965 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
969 if (baseclass
== first_dont_print
[j
])
972 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
975 boffset
= baseclass_offset (type
, i
, valaddr
, address
);
979 fprintf_filtered (stream
, "\n");
980 print_spaces_filtered (2 * recurse
, stream
);
982 fputs_filtered ("<", stream
);
983 /* Not sure what the best notation is in the case where there is no
986 fputs_filtered (basename
? basename
: "", stream
);
987 fputs_filtered ("> = ", stream
);
989 /* The virtual base class pointer might have been clobbered by the
990 user program. Make sure that it still points to a valid memory
993 if (boffset
!= -1 && (boffset
< 0 || boffset
>= TYPE_LENGTH (type
)))
995 base_valaddr
= (char *) alloca (TYPE_LENGTH (baseclass
));
996 if (target_read_memory (address
+ boffset
, base_valaddr
,
997 TYPE_LENGTH (baseclass
)) != 0)
1001 base_valaddr
= valaddr
+ boffset
;
1004 fprintf_filtered (stream
, "<invalid address>");
1006 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
1007 stream
, format
, recurse
, pretty
,
1008 (struct type
**) obstack_base (&dont_print_vb_obstack
),
1010 fputs_filtered (", ", stream
);
1016 if (dont_print_vb
== 0)
1018 /* Free the space used to deal with the printing
1019 of this type from top level. */
1020 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
1021 /* Reset watermark so that we can continue protecting
1022 ourselves from whatever we were protecting ourselves. */
1023 dont_print_vb_obstack
= tmp_obstack
;
1027 /* Print value of a static member.
1028 To avoid infinite recursion when printing a class that contains
1029 a static instance of the class, we keep the addresses of all printed
1030 static member classes in an obstack and refuse to print them more
1033 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1034 have the same meanings as in c_val_print. */
1037 pascal_object_print_static_field (type
, val
, stream
, format
, recurse
, pretty
)
1040 struct ui_file
*stream
;
1043 enum val_prettyprint pretty
;
1045 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1047 CORE_ADDR
*first_dont_print
;
1051 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1052 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1057 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1059 fputs_filtered ("<same as static member of an already seen type>",
1065 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1066 sizeof (CORE_ADDR
));
1068 CHECK_TYPEDEF (type
);
1069 pascal_object_print_value_fields (type
, VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
1070 stream
, format
, recurse
, pretty
, NULL
, 1);
1073 val_print (type
, VALUE_CONTENTS (val
), 0, VALUE_ADDRESS (val
),
1074 stream
, format
, 0, recurse
, pretty
);
1078 pascal_object_print_class_member (valaddr
, domain
, stream
, prefix
)
1080 struct type
*domain
;
1081 struct ui_file
*stream
;
1085 /* VAL is a byte offset into the structure type DOMAIN.
1086 Find the name of the field for that offset and
1090 register unsigned int i
;
1091 unsigned len
= TYPE_NFIELDS (domain
);
1092 /* @@ Make VAL into bit offset */
1093 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1094 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1096 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1100 if (val
< bitpos
&& i
!= 0)
1102 /* Somehow pointing into a field. */
1104 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1115 fprintf_filtered (stream
, prefix
);
1116 name
= type_name_no_tag (domain
);
1118 fputs_filtered (name
, stream
);
1120 pascal_type_print_base (domain
, stream
, 0, 0);
1121 fprintf_filtered (stream
, "::");
1122 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1124 fprintf_filtered (stream
, " + %d bytes", extra
);
1126 fprintf_filtered (stream
, " (offset in bits)");
1129 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1134 _initialize_pascal_valprint ()
1137 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1138 (char *) &pascal_static_field_print
,
1139 "Set printing of pascal static members.",
1142 /* Turn on printing of static fields. */
1143 pascal_static_field_print
= 1;