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
;
80 switch (TYPE_CODE (type
))
83 if (get_array_bounds (type
, &low_bound
, &high_bound
))
85 len
= high_bound
- low_bound
+ 1;
86 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
87 eltlen
= TYPE_LENGTH (elttype
);
88 if (options
->prettyprint_arrays
)
90 print_spaces_filtered (2 + 2 * recurse
, stream
);
92 /* If 's' format is used, try to print out as string.
93 If no format is given, print as string if element type
94 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
95 if (options
->format
== 's'
96 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
97 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
98 && options
->format
== 0))
100 /* If requested, look for the first null char and only print
101 elements up to it. */
102 if (options
->stop_print_at_null
)
104 unsigned int temp_len
;
106 /* Look for a NULL char. */
108 extract_unsigned_integer (valaddr
+ embedded_offset
+
109 temp_len
* eltlen
, eltlen
,
111 && temp_len
< len
&& temp_len
< options
->print_max
;
116 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
117 valaddr
+ embedded_offset
, len
, NULL
, 0,
123 fprintf_filtered (stream
, "{");
124 /* If this is a virtual function table, print the 0th
125 entry specially, and the rest of the members normally. */
126 if (pascal_object_is_vtbl_ptr_type (elttype
))
129 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
135 val_print_array_elements (type
, valaddr
, embedded_offset
,
136 address
, stream
, recurse
,
137 original_value
, options
, i
);
138 fprintf_filtered (stream
, "}");
142 /* Array of unspecified length: treat like pointer to first elt. */
143 addr
= address
+ embedded_offset
;
144 goto print_unpacked_pointer
;
147 if (options
->format
&& options
->format
!= 's')
149 val_print_scalar_formatted (type
, valaddr
, embedded_offset
,
150 original_value
, options
, 0, stream
);
153 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
155 /* Print the unmangled name if desired. */
156 /* Print vtable entry - we only get here if we ARE using
157 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
158 /* Extract the address, assume that it is unsigned. */
159 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
160 TYPE_LENGTH (type
), byte_order
);
161 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
164 check_typedef (TYPE_TARGET_TYPE (type
));
166 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
167 print_unpacked_pointer
:
168 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
170 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
172 /* Try to print what function it points to. */
173 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
177 if (options
->addressprint
&& options
->format
!= 's')
179 fputs_filtered (paddress (gdbarch
, addr
), stream
);
183 /* For a pointer to char or unsigned char, also print the string
184 pointed to, unless pointer is null. */
185 if (((TYPE_LENGTH (elttype
) == 1
186 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
187 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
188 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
189 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
190 && (options
->format
== 0 || options
->format
== 's')
194 fputs_filtered (" ", stream
);
195 /* No wide string yet. */
196 i
= val_print_string (elttype
, NULL
, addr
, -1, stream
, options
);
198 /* Also for pointers to pascal strings. */
199 /* Note: this is Free Pascal specific:
200 as GDB does not recognize stabs pascal strings
201 Pascal strings are mapped to records
202 with lowercase names PM. */
203 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
204 &string_pos
, &char_type
, NULL
)
207 ULONGEST string_length
;
211 fputs_filtered (" ", stream
);
212 buffer
= xmalloc (length_size
);
213 read_memory (addr
+ length_pos
, buffer
, length_size
);
214 string_length
= extract_unsigned_integer (buffer
, length_size
,
217 i
= val_print_string (char_type
, NULL
,
218 addr
+ string_pos
, string_length
,
221 else if (pascal_object_is_vtbl_member (type
))
223 /* Print vtbl's nicely. */
224 CORE_ADDR vt_address
= unpack_pointer (type
,
225 valaddr
+ embedded_offset
);
226 struct minimal_symbol
*msymbol
=
227 lookup_minimal_symbol_by_pc (vt_address
);
229 /* If 'symbol_print' is set, we did the work above. */
230 if (!options
->symbol_print
232 && (vt_address
== SYMBOL_VALUE_ADDRESS (msymbol
)))
235 fputs_filtered (" ", stream
);
236 fputs_filtered ("<", stream
);
237 fputs_filtered (SYMBOL_PRINT_NAME (msymbol
), stream
);
238 fputs_filtered (">", stream
);
241 if (vt_address
&& options
->vtblprint
)
243 struct value
*vt_val
;
244 struct symbol
*wsym
= (struct symbol
*) NULL
;
246 struct block
*block
= (struct block
*) NULL
;
250 fputs_filtered (" ", stream
);
253 wsym
= lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol
), block
,
254 VAR_DOMAIN
, &is_this_fld
);
258 wtype
= SYMBOL_TYPE (wsym
);
262 wtype
= TYPE_TARGET_TYPE (type
);
264 vt_val
= value_at (wtype
, vt_address
);
265 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
269 fprintf_filtered (stream
, "\n");
270 print_spaces_filtered (2 + 2 * recurse
, stream
);
279 case TYPE_CODE_FLAGS
:
281 case TYPE_CODE_RANGE
:
285 case TYPE_CODE_ERROR
:
286 case TYPE_CODE_UNDEF
:
289 generic_val_print (type
, valaddr
, embedded_offset
, address
,
290 stream
, recurse
, original_value
, options
,
294 case TYPE_CODE_UNION
:
295 if (recurse
&& !options
->unionprint
)
297 fprintf_filtered (stream
, "{...}");
301 case TYPE_CODE_STRUCT
:
302 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
304 /* Print the unmangled name if desired. */
305 /* Print vtable entry - we only get here if NOT using
306 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
307 /* Extract the address, assume that it is unsigned. */
308 print_address_demangle
310 extract_unsigned_integer (valaddr
+ embedded_offset
311 + TYPE_FIELD_BITPOS (type
,
312 VTBL_FNADDR_OFFSET
) / 8,
313 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
314 VTBL_FNADDR_OFFSET
)),
320 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
321 &string_pos
, &char_type
, NULL
))
323 len
= extract_unsigned_integer (valaddr
+ embedded_offset
324 + length_pos
, length_size
,
326 LA_PRINT_STRING (stream
, char_type
,
327 valaddr
+ embedded_offset
+ string_pos
,
328 len
, NULL
, 0, options
);
331 pascal_object_print_value_fields (type
, valaddr
, embedded_offset
,
332 address
, stream
, recurse
,
333 original_value
, options
,
338 case TYPE_CODE_BITSTRING
:
340 elttype
= TYPE_INDEX_TYPE (type
);
341 CHECK_TYPEDEF (elttype
);
342 if (TYPE_STUB (elttype
))
344 fprintf_filtered (stream
, "<incomplete type>");
350 struct type
*range
= elttype
;
351 LONGEST low_bound
, high_bound
;
353 int is_bitstring
= TYPE_CODE (type
) == TYPE_CODE_BITSTRING
;
357 fputs_filtered ("B'", stream
);
359 fputs_filtered ("[", stream
);
361 i
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
362 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
364 /* If we know the size of the set type, we can figure out the
367 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
368 TYPE_HIGH_BOUND (range
) = high_bound
;
373 fputs_filtered ("<error value>", stream
);
377 for (i
= low_bound
; i
<= high_bound
; i
++)
379 int element
= value_bit_index (type
,
380 valaddr
+ embedded_offset
, i
);
385 goto maybe_bad_bstring
;
388 fprintf_filtered (stream
, "%d", element
);
392 fputs_filtered (", ", stream
);
393 print_type_scalar (range
, i
, stream
);
396 if (i
+ 1 <= high_bound
397 && value_bit_index (type
,
398 valaddr
+ embedded_offset
, ++i
))
402 fputs_filtered ("..", stream
);
403 while (i
+ 1 <= high_bound
404 && value_bit_index (type
,
405 valaddr
+ embedded_offset
,
408 print_type_scalar (range
, j
, stream
);
414 fputs_filtered ("'", stream
);
416 fputs_filtered ("]", stream
);
421 error (_("Invalid pascal type code %d in symbol table."),
428 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
429 const struct value_print_options
*options
)
431 struct type
*type
= value_type (val
);
432 struct value_print_options opts
= *options
;
436 /* If it is a pointer, indicate what it points to.
438 Print type also if it is a reference.
440 Object pascal: if it is a member pointer, we will take care
441 of that when we print it. */
442 if (TYPE_CODE (type
) == TYPE_CODE_PTR
443 || TYPE_CODE (type
) == TYPE_CODE_REF
)
445 /* Hack: remove (char *) for char strings. Their
446 type is indicated by the quoted string anyway. */
447 if (TYPE_CODE (type
) == TYPE_CODE_PTR
448 && TYPE_NAME (type
) == NULL
449 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
450 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
456 fprintf_filtered (stream
, "(");
457 type_print (type
, "", stream
, -1);
458 fprintf_filtered (stream
, ") ");
461 common_val_print (val
, stream
, 0, &opts
, current_language
);
466 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
467 struct cmd_list_element
*c
, const char *value
)
469 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
473 static struct obstack dont_print_vb_obstack
;
474 static struct obstack dont_print_statmem_obstack
;
476 static void pascal_object_print_static_field (struct value
*,
477 struct ui_file
*, int,
478 const struct value_print_options
*);
480 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
482 CORE_ADDR
, struct ui_file
*, int,
483 const struct value
*,
484 const struct value_print_options
*,
487 /* It was changed to this after 2.4.5. */
488 const char pascal_vtbl_ptr_name
[] =
489 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
491 /* Return truth value for assertion that TYPE is of the type
492 "pointer to virtual function". */
495 pascal_object_is_vtbl_ptr_type (struct type
*type
)
497 const char *typename
= type_name_no_tag (type
);
499 return (typename
!= NULL
500 && strcmp (typename
, pascal_vtbl_ptr_name
) == 0);
503 /* Return truth value for the assertion that TYPE is of the type
504 "pointer to virtual function table". */
507 pascal_object_is_vtbl_member (struct type
*type
)
509 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
511 type
= TYPE_TARGET_TYPE (type
);
512 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
514 type
= TYPE_TARGET_TYPE (type
);
515 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* If not using
517 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* If using thunks. */
519 /* Virtual functions tables are full of pointers
520 to virtual functions. */
521 return pascal_object_is_vtbl_ptr_type (type
);
528 /* Mutually recursive subroutines of pascal_object_print_value and
529 c_val_print to print out a structure's fields:
530 pascal_object_print_value_fields and pascal_object_print_value.
532 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
533 same meanings as in pascal_object_print_value and c_val_print.
535 DONT_PRINT is an array of baseclass types that we
536 should not print, or zero if called from top level. */
539 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
541 CORE_ADDR address
, struct ui_file
*stream
,
543 const struct value
*val
,
544 const struct value_print_options
*options
,
545 struct type
**dont_print_vb
,
546 int dont_print_statmem
)
548 int i
, len
, n_baseclasses
;
549 char *last_dont_print
= obstack_next_free (&dont_print_statmem_obstack
);
551 CHECK_TYPEDEF (type
);
553 fprintf_filtered (stream
, "{");
554 len
= TYPE_NFIELDS (type
);
555 n_baseclasses
= TYPE_N_BASECLASSES (type
);
557 /* Print out baseclasses such that we don't print
558 duplicates of virtual baseclasses. */
559 if (n_baseclasses
> 0)
560 pascal_object_print_value (type
, valaddr
, offset
, address
,
561 stream
, recurse
+ 1, val
,
562 options
, dont_print_vb
);
564 if (!len
&& n_baseclasses
== 1)
565 fprintf_filtered (stream
, "<No data fields>");
568 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
571 if (dont_print_statmem
== 0)
573 /* If we're at top level, carve out a completely fresh
574 chunk of the obstack and use that until this particular
575 invocation returns. */
576 obstack_finish (&dont_print_statmem_obstack
);
579 for (i
= n_baseclasses
; i
< len
; i
++)
581 /* If requested, skip printing of static fields. */
582 if (!options
->pascal_static_field_print
583 && field_is_static (&TYPE_FIELD (type
, i
)))
586 fprintf_filtered (stream
, ", ");
587 else if (n_baseclasses
> 0)
591 fprintf_filtered (stream
, "\n");
592 print_spaces_filtered (2 + 2 * recurse
, stream
);
593 fputs_filtered ("members of ", stream
);
594 fputs_filtered (type_name_no_tag (type
), stream
);
595 fputs_filtered (": ", stream
);
602 fprintf_filtered (stream
, "\n");
603 print_spaces_filtered (2 + 2 * recurse
, stream
);
607 wrap_here (n_spaces (2 + 2 * recurse
));
609 if (options
->inspect_it
)
611 if (TYPE_CODE (TYPE_FIELD_TYPE (type
, i
)) == TYPE_CODE_PTR
)
612 fputs_filtered ("\"( ptr \"", stream
);
614 fputs_filtered ("\"( nodef \"", stream
);
615 if (field_is_static (&TYPE_FIELD (type
, i
)))
616 fputs_filtered ("static ", stream
);
617 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
619 DMGL_PARAMS
| DMGL_ANSI
);
620 fputs_filtered ("\" \"", stream
);
621 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
623 DMGL_PARAMS
| DMGL_ANSI
);
624 fputs_filtered ("\") \"", stream
);
628 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
630 if (field_is_static (&TYPE_FIELD (type
, i
)))
631 fputs_filtered ("static ", stream
);
632 fprintf_symbol_filtered (stream
, TYPE_FIELD_NAME (type
, i
),
634 DMGL_PARAMS
| DMGL_ANSI
);
635 annotate_field_name_end ();
636 fputs_filtered (" = ", stream
);
637 annotate_field_value ();
640 if (!field_is_static (&TYPE_FIELD (type
, i
))
641 && TYPE_FIELD_PACKED (type
, i
))
645 /* Bitfields require special handling, especially due to byte
647 if (TYPE_FIELD_IGNORE (type
, i
))
649 fputs_filtered ("<optimized out or zero length>", stream
);
651 else if (value_bits_synthetic_pointer (val
,
652 TYPE_FIELD_BITPOS (type
,
654 TYPE_FIELD_BITSIZE (type
,
657 fputs_filtered (_("<synthetic pointer>"), stream
);
659 else if (!value_bits_valid (val
, TYPE_FIELD_BITPOS (type
, i
),
660 TYPE_FIELD_BITSIZE (type
, i
)))
662 val_print_optimized_out (stream
);
666 struct value_print_options opts
= *options
;
668 v
= value_field_bitfield (type
, i
, valaddr
, offset
, val
);
671 common_val_print (v
, stream
, recurse
+ 1, &opts
,
677 if (TYPE_FIELD_IGNORE (type
, i
))
679 fputs_filtered ("<optimized out or zero length>", stream
);
681 else if (field_is_static (&TYPE_FIELD (type
, i
)))
683 /* struct value *v = value_static_field (type, i);
687 v
= value_field_bitfield (type
, i
, valaddr
, offset
, val
);
690 val_print_optimized_out (stream
);
692 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
697 struct value_print_options opts
= *options
;
700 /* val_print (TYPE_FIELD_TYPE (type, i),
701 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
702 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
703 stream, format, 0, recurse + 1, pretty); */
704 val_print (TYPE_FIELD_TYPE (type
, i
),
705 valaddr
, offset
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
706 address
, stream
, recurse
+ 1, val
, &opts
,
710 annotate_field_end ();
713 if (dont_print_statmem
== 0)
715 /* Free the space used to deal with the printing
716 of the members from top level. */
717 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
718 dont_print_statmem_obstack
= tmp_obstack
;
723 fprintf_filtered (stream
, "\n");
724 print_spaces_filtered (2 * recurse
, stream
);
727 fprintf_filtered (stream
, "}");
730 /* Special val_print routine to avoid printing multiple copies of virtual
734 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
736 CORE_ADDR address
, struct ui_file
*stream
,
738 const struct value
*val
,
739 const struct value_print_options
*options
,
740 struct type
**dont_print_vb
)
742 struct type
**last_dont_print
743 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
744 struct obstack tmp_obstack
= dont_print_vb_obstack
;
745 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
747 if (dont_print_vb
== 0)
749 /* If we're at top level, carve out a completely fresh
750 chunk of the obstack and use that until this particular
751 invocation returns. */
752 /* Bump up the high-water mark. Now alpha is omega. */
753 obstack_finish (&dont_print_vb_obstack
);
756 for (i
= 0; i
< n_baseclasses
; i
++)
759 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
760 const char *basename
= type_name_no_tag (baseclass
);
761 const gdb_byte
*base_valaddr
= NULL
;
763 volatile struct gdb_exception ex
;
766 if (BASETYPE_VIA_VIRTUAL (type
, i
))
768 struct type
**first_dont_print
769 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
771 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
775 if (baseclass
== first_dont_print
[j
])
778 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
783 TRY_CATCH (ex
, RETURN_MASK_ERROR
)
785 boffset
= baseclass_offset (type
, i
, valaddr
, offset
, address
, val
);
787 if (ex
.reason
< 0 && ex
.error
== NOT_AVAILABLE_ERROR
)
789 else if (ex
.reason
< 0)
795 /* The virtual base class pointer might have been clobbered by the
796 user program. Make sure that it still points to a valid memory
799 if (boffset
< 0 || boffset
>= TYPE_LENGTH (type
))
801 /* FIXME (alloc): not safe is baseclass is really really big. */
802 gdb_byte
*buf
= alloca (TYPE_LENGTH (baseclass
));
805 if (target_read_memory (address
+ boffset
, buf
,
806 TYPE_LENGTH (baseclass
)) != 0)
808 address
= address
+ boffset
;
813 base_valaddr
= valaddr
;
818 fprintf_filtered (stream
, "\n");
819 print_spaces_filtered (2 * recurse
, stream
);
821 fputs_filtered ("<", stream
);
822 /* Not sure what the best notation is in the case where there is no
825 fputs_filtered (basename
? basename
: "", stream
);
826 fputs_filtered ("> = ", stream
);
829 val_print_unavailable (stream
);
831 val_print_invalid_address (stream
);
833 pascal_object_print_value_fields (baseclass
, base_valaddr
,
834 thisoffset
+ boffset
, address
,
835 stream
, recurse
, val
, options
,
836 (struct type
**) obstack_base (&dont_print_vb_obstack
),
838 fputs_filtered (", ", stream
);
844 if (dont_print_vb
== 0)
846 /* Free the space used to deal with the printing
847 of this type from top level. */
848 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
849 /* Reset watermark so that we can continue protecting
850 ourselves from whatever we were protecting ourselves. */
851 dont_print_vb_obstack
= tmp_obstack
;
855 /* Print value of a static member.
856 To avoid infinite recursion when printing a class that contains
857 a static instance of the class, we keep the addresses of all printed
858 static member classes in an obstack and refuse to print them more
861 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
862 have the same meanings as in c_val_print. */
865 pascal_object_print_static_field (struct value
*val
,
866 struct ui_file
*stream
,
868 const struct value_print_options
*options
)
870 struct type
*type
= value_type (val
);
871 struct value_print_options opts
;
873 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
875 CORE_ADDR
*first_dont_print
, addr
;
879 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
880 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
885 if (value_address (val
) == first_dont_print
[i
])
888 <same as static member of an already seen type>",
894 addr
= value_address (val
);
895 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
898 CHECK_TYPEDEF (type
);
899 pascal_object_print_value_fields (type
,
900 value_contents_for_printing (val
),
901 value_embedded_offset (val
),
904 val
, options
, NULL
, 1);
910 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
913 /* -Wmissing-prototypes */
914 extern initialize_file_ftype _initialize_pascal_valprint
;
917 _initialize_pascal_valprint (void)
919 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
920 &user_print_options
.pascal_static_field_print
, _("\
921 Set printing of pascal static members."), _("\
922 Show printing of pascal static members."), NULL
,
924 show_pascal_static_field_print
,
925 &setprintlist
, &showprintlist
);