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"
34 #include "typeprint.h"
43 /* Print data of type TYPE located at VALADDR (within GDB), which came from
44 the inferior at address ADDRESS, onto stdio stream STREAM according to
45 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
48 If the data are a string pointer, returns the number of string characters
51 If DEREF_REF is nonzero, then dereference references, otherwise just print
54 The PRETTY parameter controls prettyprinting. */
58 pascal_val_print (struct type
*type
, char *valaddr
, int embedded_offset
,
59 CORE_ADDR address
, struct ui_file
*stream
, int format
,
60 int deref_ref
, int recurse
, enum val_prettyprint pretty
)
62 register unsigned int i
= 0; /* Number of characters printed */
66 int length_pos
, length_size
, string_pos
;
72 switch (TYPE_CODE (type
))
75 if (TYPE_LENGTH (type
) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type
)) > 0)
77 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
78 eltlen
= TYPE_LENGTH (elttype
);
79 len
= TYPE_LENGTH (type
) / eltlen
;
80 if (prettyprint_arrays
)
82 print_spaces_filtered (2 + 2 * recurse
, stream
);
84 /* For an array of chars, print with string syntax. */
86 ((TYPE_CODE (elttype
) == TYPE_CODE_INT
)
87 || ((current_language
->la_language
== language_m2
)
88 && (TYPE_CODE (elttype
) == TYPE_CODE_CHAR
)))
89 && (format
== 0 || format
== 's'))
91 /* If requested, look for the first null char and only print
93 if (stop_print_at_null
)
95 unsigned int temp_len
;
97 /* Look for a NULL char. */
99 (valaddr
+ embedded_offset
)[temp_len
]
100 && temp_len
< len
&& temp_len
< print_max
;
105 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
, len
, 1, 0);
110 fprintf_filtered (stream
, "{");
111 /* If this is a virtual function table, print the 0th
112 entry specially, and the rest of the members normally. */
113 if (pascal_object_is_vtbl_ptr_type (elttype
))
116 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
122 val_print_array_elements (type
, valaddr
+ embedded_offset
, address
, stream
,
123 format
, deref_ref
, recurse
, pretty
, i
);
124 fprintf_filtered (stream
, "}");
128 /* Array of unspecified length: treat like pointer to first elt. */
130 goto print_unpacked_pointer
;
133 if (format
&& format
!= 's')
135 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
138 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
140 /* Print the unmangled name if desired. */
141 /* Print vtable entry - we only get here if we ARE using
142 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
143 print_address_demangle (extract_address (valaddr
+ embedded_offset
, TYPE_LENGTH (type
)),
147 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
148 if (TYPE_CODE (elttype
) == TYPE_CODE_METHOD
)
150 pascal_object_print_class_method (valaddr
+ embedded_offset
, type
, stream
);
152 else if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
154 pascal_object_print_class_member (valaddr
+ embedded_offset
,
155 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type
)),
160 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
161 print_unpacked_pointer
:
162 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
164 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
166 /* Try to print what function it points to. */
167 print_address_demangle (addr
, stream
, demangle
);
168 /* Return value is irrelevant except for string pointers. */
172 if (addressprint
&& format
!= 's')
174 print_address_numeric (addr
, 1, stream
);
177 /* For a pointer to char or unsigned char, also print the string
178 pointed to, unless pointer is null. */
179 if (TYPE_LENGTH (elttype
) == 1
180 && TYPE_CODE (elttype
) == TYPE_CODE_INT
181 && (format
== 0 || format
== 's')
184 /* no wide string yet */
185 i
= val_print_string (addr
, -1, 1, stream
);
187 /* also for pointers to pascal strings */
188 /* Note: this is Free Pascal specific:
189 as GDB does not recognize stabs pascal strings
190 Pascal strings are mapped to records
191 with lowercase names PM */
192 if (is_pascal_string_type (elttype
, &length_pos
,
193 &length_size
, &string_pos
, &char_size
)
196 ULONGEST string_length
;
198 buffer
= xmalloc (length_size
);
199 read_memory (addr
+ length_pos
, buffer
, length_size
);
200 string_length
= extract_unsigned_integer (buffer
, length_size
);
202 i
= val_print_string (addr
+ string_pos
, string_length
, char_size
, stream
);
204 else if (pascal_object_is_vtbl_member (type
))
206 /* print vtbl's nicely */
207 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
+ embedded_offset
);
209 struct minimal_symbol
*msymbol
=
210 lookup_minimal_symbol_by_pc (vt_address
);
211 if ((msymbol
!= NULL
)
212 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
214 fputs_filtered (" <", stream
);
215 fputs_filtered (SYMBOL_SOURCE_NAME (msymbol
), stream
);
216 fputs_filtered (">", stream
);
218 if (vt_address
&& vtblprint
)
220 struct value
*vt_val
;
221 struct symbol
*wsym
= (struct symbol
*) NULL
;
224 struct block
*block
= (struct block
*) NULL
;
228 wsym
= lookup_symbol (SYMBOL_NAME (msymbol
), block
,
229 VAR_NAMESPACE
, &is_this_fld
, &s
);
233 wtype
= SYMBOL_TYPE (wsym
);
237 wtype
= TYPE_TARGET_TYPE (type
);
239 vt_val
= value_at (wtype
, vt_address
, NULL
);
240 val_print (VALUE_TYPE (vt_val
), VALUE_CONTENTS (vt_val
), 0,
241 VALUE_ADDRESS (vt_val
), stream
, format
,
242 deref_ref
, recurse
+ 1, pretty
);
245 fprintf_filtered (stream
, "\n");
246 print_spaces_filtered (2 + 2 * recurse
, stream
);
251 /* Return number of characters printed, including the terminating
252 '\0' if we reached the end. val_print_string takes care including
253 the terminating '\0' if necessary. */
258 case TYPE_CODE_MEMBER
:
259 error ("not implemented: member type in pascal_val_print");
263 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
264 if (TYPE_CODE (elttype
) == TYPE_CODE_MEMBER
)
266 pascal_object_print_class_member (valaddr
+ embedded_offset
,
267 TYPE_DOMAIN_TYPE (elttype
),
273 fprintf_filtered (stream
, "@");
274 print_address_numeric
275 (extract_address (valaddr
+ embedded_offset
,
276 TARGET_PTR_BIT
/ HOST_CHAR_BIT
), 1, stream
);
278 fputs_filtered (": ", stream
);
280 /* De-reference the reference. */
283 if (TYPE_CODE (elttype
) != TYPE_CODE_UNDEF
)
285 struct value
*deref_val
=
287 (TYPE_TARGET_TYPE (type
),
288 unpack_pointer (lookup_pointer_type (builtin_type_void
),
289 valaddr
+ embedded_offset
),
291 val_print (VALUE_TYPE (deref_val
),
292 VALUE_CONTENTS (deref_val
), 0,
293 VALUE_ADDRESS (deref_val
), stream
, format
,
294 deref_ref
, recurse
+ 1, pretty
);
297 fputs_filtered ("???", stream
);
301 case TYPE_CODE_UNION
:
302 if (recurse
&& !unionprint
)
304 fprintf_filtered (stream
, "{...}");
308 case TYPE_CODE_STRUCT
:
309 if (vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
311 /* Print the unmangled name if desired. */
312 /* Print vtable entry - we only get here if NOT using
313 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
314 print_address_demangle (extract_address (
315 valaddr
+ embedded_offset
+ TYPE_FIELD_BITPOS (type
, VTBL_FNADDR_OFFSET
) / 8,
316 TYPE_LENGTH (TYPE_FIELD_TYPE (type
, VTBL_FNADDR_OFFSET
))),
321 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
322 &string_pos
, &char_size
))
324 len
= extract_unsigned_integer (valaddr
+ embedded_offset
+ length_pos
, length_size
);
325 LA_PRINT_STRING (stream
, valaddr
+ embedded_offset
+ string_pos
, len
, char_size
, 0);
328 pascal_object_print_value_fields (type
, valaddr
+ embedded_offset
, address
, stream
, format
,
329 recurse
, pretty
, NULL
, 0);
336 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
339 len
= TYPE_NFIELDS (type
);
340 val
= unpack_long (type
, valaddr
+ embedded_offset
);
341 for (i
= 0; i
< len
; i
++)
344 if (val
== TYPE_FIELD_BITPOS (type
, i
))
351 fputs_filtered (TYPE_FIELD_NAME (type
, i
), stream
);
355 print_longest (stream
, 'd', 0, val
);
362 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
365 /* FIXME, we should consider, at least for ANSI C language, eliminating
366 the distinction made between FUNCs and POINTERs to FUNCs. */
367 fprintf_filtered (stream
, "{");
368 type_print (type
, "", stream
, -1);
369 fprintf_filtered (stream
, "} ");
370 /* Try to print what function it points to, and its address. */
371 print_address_demangle (address
, stream
, demangle
);
375 format
= format
? format
: output_format
;
377 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
380 val
= unpack_long (type
, valaddr
+ embedded_offset
);
382 fputs_filtered ("false", stream
);
384 fputs_filtered ("true", stream
);
387 fputs_filtered ("true (", stream
);
388 fprintf_filtered (stream
, "%ld)", (long int) val
);
393 case TYPE_CODE_RANGE
:
394 /* FIXME: create_range_type does not set the unsigned bit in a
395 range type (I think it probably should copy it from the target
396 type), so we won't print values which are too large to
397 fit in a signed integer correctly. */
398 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
399 print with the target type, though, because the size of our type
400 and the target type might differ). */
404 format
= format
? format
: output_format
;
407 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
411 val_print_type_code_int (type
, valaddr
+ embedded_offset
, stream
);
416 format
= format
? format
: output_format
;
419 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
423 val
= unpack_long (type
, valaddr
+ embedded_offset
);
424 if (TYPE_UNSIGNED (type
))
425 fprintf_filtered (stream
, "%u", (unsigned int) val
);
427 fprintf_filtered (stream
, "%d", (int) val
);
428 fputs_filtered (" ", stream
);
429 LA_PRINT_CHAR ((unsigned char) val
, stream
);
436 print_scalar_formatted (valaddr
+ embedded_offset
, type
, format
, 0, stream
);
440 print_floating (valaddr
+ embedded_offset
, type
, stream
);
444 case TYPE_CODE_BITSTRING
:
446 elttype
= TYPE_INDEX_TYPE (type
);
447 CHECK_TYPEDEF (elttype
);
448 if (TYPE_FLAGS (elttype
) & TYPE_FLAG_STUB
)
450 fprintf_filtered (stream
, "<incomplete type>");
456 struct type
*range
= elttype
;
457 LONGEST low_bound
, high_bound
;
459 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
463 fputs_filtered ("B'", stream
);
465 fputs_filtered ("[", stream
);
467 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
471 fputs_filtered ("<error value>", stream
);
475 for (i
= low_bound
; i
<= high_bound
; i
++)
477 int element
= value_bit_index (type
, valaddr
+ embedded_offset
, i
);
481 goto maybe_bad_bstring
;
484 fprintf_filtered (stream
, "%d", element
);
488 fputs_filtered (", ", stream
);
489 print_type_scalar (range
, i
, stream
);
492 if (i
+ 1 <= high_bound
&& value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
495 fputs_filtered ("..", stream
);
496 while (i
+ 1 <= high_bound
497 && value_bit_index (type
, valaddr
+ embedded_offset
, ++i
))
499 print_type_scalar (range
, j
, stream
);
505 fputs_filtered ("'", stream
);
507 fputs_filtered ("]", stream
);
512 fprintf_filtered (stream
, "void");
515 case TYPE_CODE_ERROR
:
516 fprintf_filtered (stream
, "<error type>");
519 case TYPE_CODE_UNDEF
:
520 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
521 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
522 and no complete type for struct foo in that file. */
523 fprintf_filtered (stream
, "<incomplete type>");
527 error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type
));
534 pascal_value_print (struct value
*val
, struct ui_file
*stream
, int format
,
535 enum val_prettyprint pretty
)
537 struct type
*type
= VALUE_TYPE (val
);
539 /* If it is a pointer, indicate what it points to.
541 Print type also if it is a reference.
543 Object pascal: if it is a member pointer, we will take care
544 of that when we print it. */
545 if (TYPE_CODE (type
) == TYPE_CODE_PTR
||
546 TYPE_CODE (type
) == TYPE_CODE_REF
)
548 /* Hack: remove (char *) for char strings. Their
549 type is indicated by the quoted string anyway. */
550 if (TYPE_CODE (type
) == TYPE_CODE_PTR
&&
551 TYPE_NAME (type
) == NULL
&&
552 TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
&&
553 STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char"))
559 fprintf_filtered (stream
, "(");
560 type_print (type
, "", stream
, -1);
561 fprintf_filtered (stream
, ") ");
564 return val_print (type
, VALUE_CONTENTS (val
), VALUE_EMBEDDED_OFFSET (val
),
565 VALUE_ADDRESS (val
) + VALUE_OFFSET (val
),
566 stream
, format
, 1, 0, pretty
);
570 /******************************************************************************
571 Inserted from cp-valprint
572 ******************************************************************************/
574 extern int vtblprint
; /* Controls printing of vtbl's */
575 extern int objectprint
; /* Controls looking up an object's derived type
576 using what we find in its vtables. */
577 static int pascal_static_field_print
; /* Controls printing of static fields. */
579 static struct obstack dont_print_vb_obstack
;
580 static struct obstack dont_print_statmem_obstack
;
582 static void pascal_object_print_static_field (struct type
*, struct value
*,
583 struct ui_file
*, int, int,
584 enum val_prettyprint
);
587 pascal_object_print_value (struct type
*, char *, CORE_ADDR
, struct ui_file
*,
588 int, int, enum val_prettyprint
, struct type
**);
591 pascal_object_print_class_method (char *valaddr
, struct type
*type
,
592 struct ui_file
*stream
)
595 struct fn_field
*f
= NULL
;
604 struct type
*target_type
= check_typedef (TYPE_TARGET_TYPE (type
));
606 domain
= TYPE_DOMAIN_TYPE (target_type
);
607 if (domain
== (struct type
*) NULL
)
609 fprintf_filtered (stream
, "<unknown>");
612 addr
= unpack_pointer (lookup_pointer_type (builtin_type_void
), valaddr
);
613 if (METHOD_PTR_IS_VIRTUAL (addr
))
615 offset
= METHOD_PTR_TO_VOFFSET (addr
);
616 len
= TYPE_NFN_FIELDS (domain
);
617 for (i
= 0; i
< len
; i
++)
619 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
620 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
622 for (j
= 0; j
< len2
; j
++)
625 if (TYPE_FN_FIELD_VOFFSET (f
, j
) == offset
)
627 if (TYPE_FN_FIELD_STUB (f
, j
))
628 check_stub_method (domain
, i
, j
);
637 sym
= find_pc_function (addr
);
640 error ("invalid pointer to member function");
642 len
= TYPE_NFN_FIELDS (domain
);
643 for (i
= 0; i
< len
; i
++)
645 f
= TYPE_FN_FIELDLIST1 (domain
, i
);
646 len2
= TYPE_FN_FIELDLIST_LENGTH (domain
, i
);
648 for (j
= 0; j
< len2
; j
++)
651 if (TYPE_FN_FIELD_STUB (f
, j
))
652 check_stub_method (domain
, i
, j
);
653 if (STREQ (SYMBOL_NAME (sym
), TYPE_FN_FIELD_PHYSNAME (f
, j
)))
663 char *demangled_name
;
665 fprintf_filtered (stream
, "&");
666 fprintf_filtered (stream
, kind
);
667 demangled_name
= cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f
, j
),
668 DMGL_ANSI
| DMGL_PARAMS
);
669 if (demangled_name
== NULL
)
670 fprintf_filtered (stream
, "<badly mangled name %s>",
671 TYPE_FN_FIELD_PHYSNAME (f
, j
));
674 fputs_filtered (demangled_name
, stream
);
675 xfree (demangled_name
);
680 fprintf_filtered (stream
, "(");
681 type_print (type
, "", stream
, -1);
682 fprintf_filtered (stream
, ") %d", (int) addr
>> 3);
686 /* It was changed to this after 2.4.5. */
687 const char pascal_vtbl_ptr_name
[] =
688 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
690 /* Return truth value for assertion that TYPE is of the type
691 "pointer to virtual function". */
694 pascal_object_is_vtbl_ptr_type (struct type
*type
)
696 char *typename
= type_name_no_tag (type
);
698 return (typename
!= NULL
699 && (STREQ (typename
, pascal_vtbl_ptr_name
)));
702 /* Return truth value for the assertion that TYPE is of the type
703 "pointer to virtual function table". */
706 pascal_object_is_vtbl_member (struct type
*type
)
708 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
710 type
= TYPE_TARGET_TYPE (type
);
711 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
713 type
= TYPE_TARGET_TYPE (type
);
714 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* if not using thunks */
715 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* if using thunks */
717 /* Virtual functions tables are full of pointers
718 to virtual functions. */
719 return pascal_object_is_vtbl_ptr_type (type
);
726 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
727 print out a structure's fields: 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
, char *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>");
763 extern int inspect_it
;
766 if (dont_print_statmem
== 0)
768 /* If we're at top level, carve out a completely fresh
769 chunk of the obstack and use that until this particular
770 invocation returns. */
771 tmp_obstack
= dont_print_statmem_obstack
;
772 obstack_finish (&dont_print_statmem_obstack
);
775 for (i
= n_baseclasses
; i
< len
; i
++)
777 /* If requested, skip printing of static fields. */
778 if (!pascal_static_field_print
&& TYPE_FIELD_STATIC (type
, i
))
781 fprintf_filtered (stream
, ", ");
782 else if (n_baseclasses
> 0)
786 fprintf_filtered (stream
, "\n");
787 print_spaces_filtered (2 + 2 * recurse
, stream
);
788 fputs_filtered ("members of ", stream
);
789 fputs_filtered (type_name_no_tag (type
), stream
);
790 fputs_filtered (": ", stream
);
797 fprintf_filtered (stream
, "\n");
798 print_spaces_filtered (2 + 2 * recurse
, stream
);
802 wrap_here (n_spaces (2 + 2 * recurse
));
806 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
807 fputs_filtered ("\"( ptr \"", stream
);
809 fputs_filtered ("\"( nodef \"", stream
);
810 if (TYPE_FIELD_STATIC (type
, i
))
811 fputs_filtered ("static ", stream
);
812 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
814 DMGL_PARAMS
| DMGL_ANSI
);
815 fputs_filtered ("\" \"", stream
);
816 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
818 DMGL_PARAMS
| DMGL_ANSI
);
819 fputs_filtered ("\") \"", stream
);
823 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
825 if (TYPE_FIELD_STATIC (type
, i
))
826 fputs_filtered ("static ", stream
);
827 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
829 DMGL_PARAMS
| DMGL_ANSI
);
830 annotate_field_name_end ();
831 fputs_filtered (" = ", stream
);
832 annotate_field_value ();
835 if (!TYPE_FIELD_STATIC (type
, i
) && TYPE_FIELD_PACKED (type
, i
))
839 /* Bitfields require special handling, especially due to byte
841 if (TYPE_FIELD_IGNORE (type
, i
))
843 fputs_filtered ("<optimized out or zero length>", stream
);
847 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
848 unpack_field_as_long (type
, valaddr
, i
));
850 val_print (TYPE_FIELD_TYPE (type
, i
), VALUE_CONTENTS (v
), 0, 0,
851 stream
, format
, 0, recurse
+ 1, pretty
);
856 if (TYPE_FIELD_IGNORE (type
, i
))
858 fputs_filtered ("<optimized out or zero length>", stream
);
860 else if (TYPE_FIELD_STATIC (type
, i
))
862 /* struct value *v = value_static_field (type, i); v4.17 specific */
864 v
= value_from_longest (TYPE_FIELD_TYPE (type
, i
),
865 unpack_field_as_long (type
, valaddr
, i
));
868 fputs_filtered ("<optimized out>", stream
);
870 pascal_object_print_static_field (TYPE_FIELD_TYPE (type
, i
), v
,
871 stream
, format
, recurse
+ 1,
876 /* val_print (TYPE_FIELD_TYPE (type, i),
877 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
878 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
879 stream, format, 0, recurse + 1, pretty); */
880 val_print (TYPE_FIELD_TYPE (type
, i
),
881 valaddr
, TYPE_FIELD_BITPOS (type
, i
) / 8,
882 address
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
883 stream
, format
, 0, recurse
+ 1, pretty
);
886 annotate_field_end ();
889 if (dont_print_statmem
== 0)
891 /* Free the space used to deal with the printing
892 of the members from top level. */
893 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
894 dont_print_statmem_obstack
= tmp_obstack
;
899 fprintf_filtered (stream
, "\n");
900 print_spaces_filtered (2 * recurse
, stream
);
903 fprintf_filtered (stream
, "}");
906 /* Special val_print routine to avoid printing multiple copies of virtual
910 pascal_object_print_value (struct type
*type
, char *valaddr
, CORE_ADDR address
,
911 struct ui_file
*stream
, 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
);
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 base_valaddr
= (char *) alloca (TYPE_LENGTH (baseclass
));
973 if (target_read_memory (address
+ boffset
, base_valaddr
,
974 TYPE_LENGTH (baseclass
)) != 0)
978 base_valaddr
= valaddr
+ boffset
;
981 fprintf_filtered (stream
, "<invalid address>");
983 pascal_object_print_value_fields (baseclass
, base_valaddr
, address
+ boffset
,
984 stream
, format
, recurse
, pretty
,
985 (struct type
**) obstack_base (&dont_print_vb_obstack
),
987 fputs_filtered (", ", stream
);
993 if (dont_print_vb
== 0)
995 /* Free the space used to deal with the printing
996 of this type from top level. */
997 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
998 /* Reset watermark so that we can continue protecting
999 ourselves from whatever we were protecting ourselves. */
1000 dont_print_vb_obstack
= tmp_obstack
;
1004 /* Print value of a static member.
1005 To avoid infinite recursion when printing a class that contains
1006 a static instance of the class, we keep the addresses of all printed
1007 static member classes in an obstack and refuse to print them more
1010 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1011 have the same meanings as in c_val_print. */
1014 pascal_object_print_static_field (struct type
*type
, struct value
*val
,
1015 struct ui_file
*stream
, int format
,
1016 int recurse
, enum val_prettyprint pretty
)
1018 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1020 CORE_ADDR
*first_dont_print
;
1024 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1025 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1030 if (VALUE_ADDRESS (val
) == first_dont_print
[i
])
1032 fputs_filtered ("<same as static member of an already seen type>",
1038 obstack_grow (&dont_print_statmem_obstack
, (char *) &VALUE_ADDRESS (val
),
1039 sizeof (CORE_ADDR
));
1041 CHECK_TYPEDEF (type
);
1042 pascal_object_print_value_fields (type
, VALUE_CONTENTS (val
), VALUE_ADDRESS (val
),
1043 stream
, format
, recurse
, pretty
, NULL
, 1);
1046 val_print (type
, VALUE_CONTENTS (val
), 0, VALUE_ADDRESS (val
),
1047 stream
, format
, 0, recurse
, pretty
);
1051 pascal_object_print_class_member (char *valaddr
, struct type
*domain
,
1052 struct ui_file
*stream
, char *prefix
)
1055 /* VAL is a byte offset into the structure type DOMAIN.
1056 Find the name of the field for that offset and
1060 register unsigned int i
;
1061 unsigned len
= TYPE_NFIELDS (domain
);
1062 /* @@ Make VAL into bit offset */
1063 LONGEST val
= unpack_long (builtin_type_int
, valaddr
) << 3;
1064 for (i
= TYPE_N_BASECLASSES (domain
); i
< len
; i
++)
1066 int bitpos
= TYPE_FIELD_BITPOS (domain
, i
);
1070 if (val
< bitpos
&& i
!= 0)
1072 /* Somehow pointing into a field. */
1074 extra
= (val
- TYPE_FIELD_BITPOS (domain
, i
));
1085 fprintf_filtered (stream
, prefix
);
1086 name
= type_name_no_tag (domain
);
1088 fputs_filtered (name
, stream
);
1090 pascal_type_print_base (domain
, stream
, 0, 0);
1091 fprintf_filtered (stream
, "::");
1092 fputs_filtered (TYPE_FIELD_NAME (domain
, i
), stream
);
1094 fprintf_filtered (stream
, " + %d bytes", extra
);
1096 fprintf_filtered (stream
, " (offset in bits)");
1099 fprintf_filtered (stream
, "%ld", (long int) (val
>> 3));
1104 _initialize_pascal_valprint (void)
1107 (add_set_cmd ("pascal_static-members", class_support
, var_boolean
,
1108 (char *) &pascal_static_field_print
,
1109 "Set printing of pascal static members.",
1112 /* Turn on printing of static fields. */
1113 pascal_static_field_print
= 1;