1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000-2001, 2003, 2005-2012 Free Software Foundation,
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* This file is derived from c-valprint.c */
24 #include "gdb_obstack.h"
27 #include "expression.h"
34 #include "typeprint.h"
40 #include "cp-support.h"
41 #include "exceptions.h"
44 /* Decorations for Pascal. */
46 static const struct generic_val_print_decorations p_decorations
=
56 /* See val_print for a description of the various parameters of this
57 function; they are identical. */
60 pascal_val_print (struct type
*type
, const gdb_byte
*valaddr
,
61 int embedded_offset
, CORE_ADDR address
,
62 struct ui_file
*stream
, int recurse
,
63 const struct value
*original_value
,
64 const struct value_print_options
*options
)
66 struct gdbarch
*gdbarch
= get_type_arch (type
);
67 enum bfd_endian byte_order
= gdbarch_byte_order (gdbarch
);
68 unsigned int i
= 0; /* Number of characters printed */
70 LONGEST low_bound
, high_bound
;
73 int length_pos
, length_size
, string_pos
;
74 struct type
*char_type
;
79 switch (TYPE_CODE (type
))
82 if (get_array_bounds (type
, &low_bound
, &high_bound
))
84 len
= high_bound
- low_bound
+ 1;
85 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
86 eltlen
= TYPE_LENGTH (elttype
);
87 if (options
->prettyprint_arrays
)
89 print_spaces_filtered (2 + 2 * recurse
, stream
);
91 /* If 's' format is used, try to print out as string.
92 If no format is given, print as string if element type
93 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
94 if (options
->format
== 's'
95 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
96 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
97 && options
->format
== 0))
99 /* If requested, look for the first null char and only print
100 elements up to it. */
101 if (options
->stop_print_at_null
)
103 unsigned int temp_len
;
105 /* Look for a NULL char. */
107 extract_unsigned_integer (valaddr
+ embedded_offset
+
108 temp_len
* eltlen
, eltlen
,
110 && temp_len
< len
&& temp_len
< options
->print_max
;
115 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
116 valaddr
+ embedded_offset
, len
, NULL
, 0,
122 fprintf_filtered (stream
, "{");
123 /* If this is a virtual function table, print the 0th
124 entry specially, and the rest of the members normally. */
125 if (pascal_object_is_vtbl_ptr_type (elttype
))
128 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
134 val_print_array_elements (type
, valaddr
, embedded_offset
,
135 address
, stream
, recurse
,
136 original_value
, options
, i
);
137 fprintf_filtered (stream
, "}");
141 /* Array of unspecified length: treat like pointer to first elt. */
142 addr
= address
+ embedded_offset
;
143 goto print_unpacked_pointer
;
146 if (options
->format
&& options
->format
!= 's')
148 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
149 original_value
, options
, 0, stream
);
152 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
154 /* Print the unmangled name if desired. */
155 /* Print vtable entry - we only get here if we ARE using
156 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
157 /* Extract the address, assume that it is unsigned. */
158 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
159 TYPE_LENGTH (type
), byte_order
);
160 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
163 check_typedef (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 (options
, gdbarch
, addr
, stream
, demangle
);
176 if (options
->addressprint
&& options
->format
!= 's')
178 fputs_filtered (paddress (gdbarch
, addr
), 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 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
187 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
188 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
189 && (options
->format
== 0 || options
->format
== 's')
193 fputs_filtered (" ", stream
);
194 /* No wide string yet. */
195 i
= val_print_string (elttype
, NULL
, addr
, -1, stream
, options
);
197 /* Also for pointers to pascal strings. */
198 /* Note: this is Free Pascal specific:
199 as GDB does not recognize stabs pascal strings
200 Pascal strings are mapped to records
201 with lowercase names PM. */
202 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
203 &string_pos
, &char_type
, NULL
)
206 ULONGEST string_length
;
210 fputs_filtered (" ", stream
);
211 buffer
= xmalloc (length_size
);
212 read_memory (addr
+ length_pos
, buffer
, length_size
);
213 string_length
= extract_unsigned_integer (buffer
, length_size
,
216 i
= val_print_string (char_type
, NULL
,
217 addr
+ string_pos
, string_length
,
220 else if (pascal_object_is_vtbl_member (type
))
222 /* Print vtbl's nicely. */
223 CORE_ADDR vt_address
= unpack_pointer (type
,
224 valaddr
+ embedded_offset
);
225 struct minimal_symbol
*msymbol
=
226 lookup_minimal_symbol_by_pc (vt_address
);
228 /* If 'symbol_print' is set, we did the work above. */
229 if (!options
->symbol_print
231 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
234 fputs_filtered (" ", stream
);
235 fputs_filtered ("<", stream
);
236 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
237 fputs_filtered (">", stream
);
240 if (vt_address
&& options
->vtblprint
)
242 struct value
*vt_val
;
243 struct symbol
*wsym
= (struct symbol
*) NULL
;
245 struct block
*block
= (struct block
*) NULL
;
249 fputs_filtered (" ", stream
);
252 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
253 VAR_DOMAIN
, &is_this_fld
);
257 wtype
= SYMBOL_TYPE (wsym
);
261 wtype
= TYPE_TARGET_TYPE (type
);
263 vt_val
= value_at (wtype
, vt_address
);
264 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
268 fprintf_filtered (stream
, "\n");
269 print_spaces_filtered (2 + 2 * recurse
, stream
);
278 case TYPE_CODE_FLAGS
:
280 case TYPE_CODE_RANGE
:
284 case TYPE_CODE_ERROR
:
285 case TYPE_CODE_UNDEF
:
288 generic_val_print (type
, valaddr
, embedded_offset
, address
,
289 stream
, recurse
, original_value
, options
,
293 case TYPE_CODE_UNION
:
294 if (recurse
&& !options
->unionprint
)
296 fprintf_filtered (stream
, "{...}");
300 case TYPE_CODE_STRUCT
:
301 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
303 /* Print the unmangled name if desired. */
304 /* Print vtable entry - we only get here if NOT using
305 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
306 /* Extract the address, assume that it is unsigned. */
307 print_address_demangle
309 extract_unsigned_integer (valaddr
+ embedded_offset
310 + TYPE_FIELD_BITPOS (type
,
311 VTBL_FNADDR_OFFSET
) / 8,
312 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
313 VTBL_FNADDR_OFFSET
)),
319 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
320 &string_pos
, &char_type
, NULL
))
322 len
= extract_unsigned_integer (valaddr
+ embedded_offset
323 + length_pos
, length_size
,
325 LA_PRINT_STRING (stream
, char_type
,
326 valaddr
+ embedded_offset
+ string_pos
,
327 len
, NULL
, 0, options
);
330 pascal_object_print_value_fields (type
, valaddr
, embedded_offset
,
331 address
, stream
, recurse
,
332 original_value
, options
,
337 case TYPE_CODE_BITSTRING
:
339 elttype
= TYPE_INDEX_TYPE (type
);
340 CHECK_TYPEDEF (elttype
);
341 if (TYPE_STUB (elttype
))
343 fprintf_filtered (stream
, "<incomplete type>");
349 struct type
*range
= elttype
;
350 LONGEST low_bound
, high_bound
;
352 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
356 fputs_filtered ("B'", stream
);
358 fputs_filtered ("[", stream
);
360 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
361 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
363 /* If we know the size of the set type, we can figure out the
366 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
367 TYPE_HIGH_BOUND (range
) = high_bound
;
372 fputs_filtered ("<error value>", stream
);
376 for (i
= low_bound
; i
<= high_bound
; i
++)
378 int element
= value_bit_index (type
,
379 valaddr
+ embedded_offset
, i
);
384 goto maybe_bad_bstring
;
387 fprintf_filtered (stream
, "%d", element
);
391 fputs_filtered (", ", stream
);
392 print_type_scalar (range
, i
, stream
);
395 if (i
+ 1 <= high_bound
396 && value_bit_index (type
,
397 valaddr
+ embedded_offset
, ++i
))
401 fputs_filtered ("..", stream
);
402 while (i
+ 1 <= high_bound
403 && value_bit_index (type
,
404 valaddr
+ embedded_offset
,
407 print_type_scalar (range
, j
, stream
);
413 fputs_filtered ("'", stream
);
415 fputs_filtered ("]", stream
);
420 error (_("Invalid pascal type code %d in symbol table."),
427 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
428 const struct value_print_options
*options
)
430 struct type
*type
= value_type (val
);
431 struct value_print_options opts
= *options
;
435 /* If it is a pointer, indicate what it points to.
437 Print type also if it is a reference.
439 Object pascal: if it is a member pointer, we will take care
440 of that when we print it. */
441 if (TYPE_CODE (type
) == TYPE_CODE_PTR
442 || TYPE_CODE (type
) == TYPE_CODE_REF
)
444 /* Hack: remove (char *) for char strings. Their
445 type is indicated by the quoted string anyway. */
446 if (TYPE_CODE (type
) == TYPE_CODE_PTR
447 && TYPE_NAME (type
) == NULL
448 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
449 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
455 fprintf_filtered (stream
, "(");
456 type_print (type
, "", stream
, -1);
457 fprintf_filtered (stream
, ") ");
460 common_val_print (val
, stream
, 0, &opts
, current_language
);
465 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
466 struct cmd_list_element
*c
, const char *value
)
468 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
472 static struct obstack dont_print_vb_obstack
;
473 static struct obstack dont_print_statmem_obstack
;
475 static void pascal_object_print_static_field (struct value
*,
476 struct ui_file
*, int,
477 const struct value_print_options
*);
479 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
481 CORE_ADDR
, struct ui_file
*, int,
482 const struct value
*,
483 const struct value_print_options
*,
486 /* It was changed to this after 2.4.5. */
487 const char pascal_vtbl_ptr_name
[] =
488 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
490 /* Return truth value for assertion that TYPE is of the type
491 "pointer to virtual function". */
494 pascal_object_is_vtbl_ptr_type (struct type
*type
)
496 const char *typename
= type_name_no_tag (type
);
498 return (typename
!= NULL
499 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
502 /* Return truth value for the assertion that TYPE is of the type
503 "pointer to virtual function table". */
506 pascal_object_is_vtbl_member (struct type
*type
)
508 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
510 type
= TYPE_TARGET_TYPE (type
);
511 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
513 type
= TYPE_TARGET_TYPE (type
);
514 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* If not using
516 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* If using thunks. */
518 /* Virtual functions tables are full of pointers
519 to virtual functions. */
520 return pascal_object_is_vtbl_ptr_type (type
);
527 /* Mutually recursive subroutines of pascal_object_print_value and
528 c_val_print to print out a structure's fields:
529 pascal_object_print_value_fields and pascal_object_print_value.
531 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
532 same meanings as in pascal_object_print_value and c_val_print.
534 DONT_PRINT is an array of baseclass types that we
535 should not print, or zero if called from top level. */
538 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
540 CORE_ADDR address
, struct ui_file
*stream
,
542 const struct value
*val
,
543 const struct value_print_options
*options
,
544 struct type
**dont_print_vb
,
545 int dont_print_statmem
)
547 int i
, len
, n_baseclasses
;
548 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
550 CHECK_TYPEDEF (type
);
552 fprintf_filtered (stream
, "{");
553 len
= TYPE_NFIELDS (type
);
554 n_baseclasses
= TYPE_N_BASECLASSES (type
);
556 /* Print out baseclasses such that we don't print
557 duplicates of virtual baseclasses. */
558 if (n_baseclasses
> 0)
559 pascal_object_print_value (type
, valaddr
, offset
, address
,
560 stream
, recurse
+ 1, val
,
561 options
, dont_print_vb
);
563 if (!len
&& n_baseclasses
== 1)
564 fprintf_filtered (stream
, "<No data fields>");
567 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
570 if (dont_print_statmem
== 0)
572 /* If we're at top level, carve out a completely fresh
573 chunk of the obstack and use that until this particular
574 invocation returns. */
575 obstack_finish (&dont_print_statmem_obstack
);
578 for (i
= n_baseclasses
; i
< len
; i
++)
580 /* If requested, skip printing of static fields. */
581 if (!options
->pascal_static_field_print
582 && field_is_static (&TYPE_FIELD (type
, i
)))
585 fprintf_filtered (stream
, ", ");
586 else if (n_baseclasses
> 0)
590 fprintf_filtered (stream
, "\n");
591 print_spaces_filtered (2 + 2 * recurse
, stream
);
592 fputs_filtered ("members of ", stream
);
593 fputs_filtered (type_name_no_tag (type
), stream
);
594 fputs_filtered (": ", stream
);
601 fprintf_filtered (stream
, "\n");
602 print_spaces_filtered (2 + 2 * recurse
, stream
);
606 wrap_here (n_spaces (2 + 2 * recurse
));
608 if (options
->inspect_it
)
610 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
611 fputs_filtered ("\"( ptr \"", stream
);
613 fputs_filtered ("\"( nodef \"", stream
);
614 if (field_is_static (&TYPE_FIELD (type
, i
)))
615 fputs_filtered ("static ", stream
);
616 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
618 DMGL_PARAMS
| DMGL_ANSI
);
619 fputs_filtered ("\" \"", stream
);
620 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
622 DMGL_PARAMS
| DMGL_ANSI
);
623 fputs_filtered ("\") \"", stream
);
627 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
629 if (field_is_static (&TYPE_FIELD (type
, i
)))
630 fputs_filtered ("static ", stream
);
631 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
633 DMGL_PARAMS
| DMGL_ANSI
);
634 annotate_field_name_end ();
635 fputs_filtered (" = ", stream
);
636 annotate_field_value ();
639 if (!field_is_static (&TYPE_FIELD (type
, i
))
640 && TYPE_FIELD_PACKED (type
, i
))
644 /* Bitfields require special handling, especially due to byte
646 if (TYPE_FIELD_IGNORE (type
, i
))
648 fputs_filtered ("<optimized out or zero length>", stream
);
650 else if (value_bits_synthetic_pointer (val
,
651 TYPE_FIELD_BITPOS (type
,
653 TYPE_FIELD_BITSIZE (type
,
656 fputs_filtered (_("<synthetic pointer>"), stream
);
658 else if (!value_bits_valid (val
, TYPE_FIELD_BITPOS (type
, i
),
659 TYPE_FIELD_BITSIZE (type
, i
)))
661 val_print_optimized_out (stream
);
665 struct value_print_options opts
= *options
;
667 v
= value_field_bitfield (type
, i
, valaddr
, offset
, val
);
670 common_val_print (v
, stream
, recurse
+ 1, &opts
,
676 if (TYPE_FIELD_IGNORE (type
, i
))
678 fputs_filtered ("<optimized out or zero length>", stream
);
680 else if (field_is_static (&TYPE_FIELD (type
, i
)))
682 /* struct value *v = value_static_field (type, i);
686 v
= value_field_bitfield (type
, i
, valaddr
, offset
, val
);
689 val_print_optimized_out (stream
);
691 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
696 struct value_print_options opts
= *options
;
699 /* val_print (TYPE_FIELD_TYPE (type, i),
700 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
701 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
702 stream, format, 0, recurse + 1, pretty); */
703 val_print (TYPE_FIELD_TYPE (type
, i
),
704 valaddr
, offset
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
705 address
, stream
, recurse
+ 1, val
, &opts
,
709 annotate_field_end ();
712 if (dont_print_statmem
== 0)
714 /* Free the space used to deal with the printing
715 of the members from top level. */
716 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
717 dont_print_statmem_obstack
= tmp_obstack
;
722 fprintf_filtered (stream
, "\n");
723 print_spaces_filtered (2 * recurse
, stream
);
726 fprintf_filtered (stream
, "}");
729 /* Special val_print routine to avoid printing multiple copies of virtual
733 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
735 CORE_ADDR address
, struct ui_file
*stream
,
737 const struct value
*val
,
738 const struct value_print_options
*options
,
739 struct type
**dont_print_vb
)
741 struct type
**last_dont_print
742 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
743 struct obstack tmp_obstack
= dont_print_vb_obstack
;
744 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
746 if (dont_print_vb
== 0)
748 /* If we're at top level, carve out a completely fresh
749 chunk of the obstack and use that until this particular
750 invocation returns. */
751 /* Bump up the high-water mark. Now alpha is omega. */
752 obstack_finish (&dont_print_vb_obstack
);
755 for (i
= 0; i
< n_baseclasses
; i
++)
758 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
759 const char *basename
= type_name_no_tag (baseclass
);
760 const gdb_byte
*base_valaddr
= NULL
;
762 volatile struct gdb_exception ex
;
765 if (BASETYPE_VIA_VIRTUAL (type
, i
))
767 struct type
**first_dont_print
768 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
770 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
774 if (baseclass
== first_dont_print
[j
])
777 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
782 TRY_CATCH (ex
, RETURN_MASK_ERROR
)
784 boffset
= baseclass_offset (type
, i
, valaddr
, offset
, address
, val
);
786 if (ex
.reason
< 0 && ex
.error
== NOT_AVAILABLE_ERROR
)
788 else if (ex
.reason
< 0)
794 /* The virtual base class pointer might have been clobbered by the
795 user program. Make sure that it still points to a valid memory
798 if (boffset
< 0 || boffset
>= TYPE_LENGTH (type
))
801 struct cleanup
*back_to
;
803 buf
= xmalloc (TYPE_LENGTH (baseclass
));
804 back_to
= make_cleanup (xfree
, buf
);
807 if (target_read_memory (address
+ boffset
, buf
,
808 TYPE_LENGTH (baseclass
)) != 0)
810 address
= address
+ boffset
;
813 do_cleanups (back_to
);
816 base_valaddr
= valaddr
;
821 fprintf_filtered (stream
, "\n");
822 print_spaces_filtered (2 * recurse
, stream
);
824 fputs_filtered ("<", stream
);
825 /* Not sure what the best notation is in the case where there is no
828 fputs_filtered (basename
? basename
: "", stream
);
829 fputs_filtered ("> = ", stream
);
832 val_print_unavailable (stream
);
834 val_print_invalid_address (stream
);
836 pascal_object_print_value_fields (baseclass
, base_valaddr
,
837 thisoffset
+ boffset
, address
,
838 stream
, recurse
, val
, options
,
839 (struct type
**) obstack_base (&dont_print_vb_obstack
),
841 fputs_filtered (", ", stream
);
847 if (dont_print_vb
== 0)
849 /* Free the space used to deal with the printing
850 of this type from top level. */
851 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
852 /* Reset watermark so that we can continue protecting
853 ourselves from whatever we were protecting ourselves. */
854 dont_print_vb_obstack
= tmp_obstack
;
858 /* Print value of a static member.
859 To avoid infinite recursion when printing a class that contains
860 a static instance of the class, we keep the addresses of all printed
861 static member classes in an obstack and refuse to print them more
864 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
865 have the same meanings as in c_val_print. */
868 pascal_object_print_static_field (struct value
*val
,
869 struct ui_file
*stream
,
871 const struct value_print_options
*options
)
873 struct type
*type
= value_type (val
);
874 struct value_print_options opts
;
876 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
878 CORE_ADDR
*first_dont_print
, addr
;
882 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
883 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
888 if (value_address (val
) == first_dont_print
[i
])
891 <same as static member of an already seen type>",
897 addr
= value_address (val
);
898 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
901 CHECK_TYPEDEF (type
);
902 pascal_object_print_value_fields (type
,
903 value_contents_for_printing (val
),
904 value_embedded_offset (val
),
907 val
, options
, NULL
, 1);
913 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
916 /* -Wmissing-prototypes */
917 extern initialize_file_ftype _initialize_pascal_valprint
;
920 _initialize_pascal_valprint (void)
922 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
923 &user_print_options
.pascal_static_field_print
, _("\
924 Set printing of pascal static members."), _("\
925 Show printing of pascal static members."), NULL
,
927 show_pascal_static_field_print
,
928 &setprintlist
, &showprintlist
);