1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000-2020 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 3 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, see <http://www.gnu.org/licenses/>. */
20 /* This file is derived from c-valprint.c */
23 #include "gdb_obstack.h"
26 #include "expression.h"
33 #include "typeprint.h"
39 #include "cp-support.h"
41 #include "gdbsupport/byte-vector.h"
42 #include "cli/cli-style.h"
45 static void pascal_object_print_value_fields (struct type
*, const gdb_byte
*,
47 CORE_ADDR
, struct ui_file
*,
50 const struct value_print_options
*,
53 static void pascal_object_print_value_fields (struct value
*, struct ui_file
*,
55 const struct value_print_options
*,
58 /* Decorations for Pascal. */
60 static const struct generic_val_print_decorations p_decorations
=
72 /* See val_print for a description of the various parameters of this
73 function; they are identical. */
76 pascal_val_print (struct type
*type
,
77 int embedded_offset
, CORE_ADDR address
,
78 struct ui_file
*stream
, int recurse
,
79 struct value
*original_value
,
80 const struct value_print_options
*options
)
82 struct gdbarch
*gdbarch
= get_type_arch (type
);
83 enum bfd_endian byte_order
= type_byte_order (type
);
84 unsigned int i
= 0; /* Number of characters printed */
88 int length_pos
, length_size
, string_pos
;
89 struct type
*char_type
;
92 const gdb_byte
*valaddr
= value_contents_for_printing (original_value
);
94 type
= check_typedef (type
);
95 switch (TYPE_CODE (type
))
99 LONGEST low_bound
, high_bound
;
101 if (get_array_bounds (type
, &low_bound
, &high_bound
))
103 len
= high_bound
- low_bound
+ 1;
104 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
105 eltlen
= TYPE_LENGTH (elttype
);
106 if (options
->prettyformat_arrays
)
108 print_spaces_filtered (2 + 2 * recurse
, stream
);
110 /* If 's' format is used, try to print out as string.
111 If no format is given, print as string if element type
112 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
113 if (options
->format
== 's'
114 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
115 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
116 && options
->format
== 0))
118 /* If requested, look for the first null char and only print
119 elements up to it. */
120 if (options
->stop_print_at_null
)
122 unsigned int temp_len
;
124 /* Look for a NULL char. */
126 extract_unsigned_integer (valaddr
+ embedded_offset
+
127 temp_len
* eltlen
, eltlen
,
129 && temp_len
< len
&& temp_len
< options
->print_max
;
134 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
135 valaddr
+ embedded_offset
, len
, NULL
, 0,
141 fprintf_filtered (stream
, "{");
142 /* If this is a virtual function table, print the 0th
143 entry specially, and the rest of the members normally. */
144 if (pascal_object_is_vtbl_ptr_type (elttype
))
147 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
153 val_print_array_elements (type
, embedded_offset
,
154 address
, stream
, recurse
,
155 original_value
, options
, i
);
156 fprintf_filtered (stream
, "}");
160 /* Array of unspecified length: treat like pointer to first elt. */
161 addr
= address
+ embedded_offset
;
163 goto print_unpacked_pointer
;
166 if (options
->format
&& options
->format
!= 's')
168 val_print_scalar_formatted (type
, embedded_offset
,
169 original_value
, options
, 0, stream
);
172 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
174 /* Print the unmangled name if desired. */
175 /* Print vtable entry - we only get here if we ARE using
176 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
177 /* Extract the address, assume that it is unsigned. */
178 addr
= extract_unsigned_integer (valaddr
+ embedded_offset
,
179 TYPE_LENGTH (type
), byte_order
);
180 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
183 check_typedef (TYPE_TARGET_TYPE (type
));
185 addr
= unpack_pointer (type
, valaddr
+ embedded_offset
);
186 print_unpacked_pointer
:
187 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
189 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
191 /* Try to print what function it points to. */
192 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
196 if (options
->addressprint
&& options
->format
!= 's')
198 fputs_filtered (paddress (gdbarch
, addr
), stream
);
202 /* For a pointer to char or unsigned char, also print the string
203 pointed to, unless pointer is null. */
204 if (((TYPE_LENGTH (elttype
) == 1
205 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
206 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
207 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
208 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
209 && (options
->format
== 0 || options
->format
== 's')
213 fputs_filtered (" ", stream
);
214 /* No wide string yet. */
215 i
= val_print_string (elttype
, NULL
, addr
, -1, stream
, options
);
217 /* Also for pointers to pascal strings. */
218 /* Note: this is Free Pascal specific:
219 as GDB does not recognize stabs pascal strings
220 Pascal strings are mapped to records
221 with lowercase names PM. */
222 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
223 &string_pos
, &char_type
, NULL
)
226 ULONGEST string_length
;
230 fputs_filtered (" ", stream
);
231 buffer
= (gdb_byte
*) xmalloc (length_size
);
232 read_memory (addr
+ length_pos
, buffer
, length_size
);
233 string_length
= extract_unsigned_integer (buffer
, length_size
,
236 i
= val_print_string (char_type
, NULL
,
237 addr
+ string_pos
, string_length
,
240 else if (pascal_object_is_vtbl_member (type
))
242 /* Print vtbl's nicely. */
243 CORE_ADDR vt_address
= unpack_pointer (type
,
244 valaddr
+ embedded_offset
);
245 struct bound_minimal_symbol msymbol
=
246 lookup_minimal_symbol_by_pc (vt_address
);
248 /* If 'symbol_print' is set, we did the work above. */
249 if (!options
->symbol_print
250 && (msymbol
.minsym
!= NULL
)
251 && (vt_address
== BMSYMBOL_VALUE_ADDRESS (msymbol
)))
254 fputs_filtered (" ", stream
);
255 fputs_filtered ("<", stream
);
256 fputs_filtered (msymbol
.minsym
->print_name (), stream
);
257 fputs_filtered (">", stream
);
260 if (vt_address
&& options
->vtblprint
)
262 struct value
*vt_val
;
263 struct symbol
*wsym
= NULL
;
267 fputs_filtered (" ", stream
);
269 if (msymbol
.minsym
!= NULL
)
271 const char *search_name
= msymbol
.minsym
->search_name ();
272 wsym
= lookup_symbol_search_name (search_name
, NULL
,
278 wtype
= SYMBOL_TYPE (wsym
);
282 wtype
= TYPE_TARGET_TYPE (type
);
284 vt_val
= value_at (wtype
, vt_address
);
285 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
287 if (options
->prettyformat
)
289 fprintf_filtered (stream
, "\n");
290 print_spaces_filtered (2 + 2 * recurse
, stream
);
299 case TYPE_CODE_FLAGS
:
301 case TYPE_CODE_RANGE
:
305 case TYPE_CODE_ERROR
:
306 case TYPE_CODE_UNDEF
:
309 generic_val_print (type
, embedded_offset
, address
,
310 stream
, recurse
, original_value
, options
,
314 case TYPE_CODE_UNION
:
315 if (recurse
&& !options
->unionprint
)
317 fprintf_filtered (stream
, "{...}");
321 case TYPE_CODE_STRUCT
:
322 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
324 /* Print the unmangled name if desired. */
325 /* Print vtable entry - we only get here if NOT using
326 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
327 /* Extract the address, assume that it is unsigned. */
328 print_address_demangle
330 extract_unsigned_integer (valaddr
+ embedded_offset
331 + TYPE_FIELD_BITPOS (type
,
332 VTBL_FNADDR_OFFSET
) / 8,
333 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
334 VTBL_FNADDR_OFFSET
)),
340 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
341 &string_pos
, &char_type
, NULL
))
343 len
= extract_unsigned_integer (valaddr
+ embedded_offset
344 + length_pos
, length_size
,
346 LA_PRINT_STRING (stream
, char_type
,
347 valaddr
+ embedded_offset
+ string_pos
,
348 len
, NULL
, 0, options
);
351 pascal_object_print_value_fields (type
, valaddr
, embedded_offset
,
352 address
, stream
, recurse
,
353 original_value
, options
,
359 elttype
= TYPE_INDEX_TYPE (type
);
360 elttype
= check_typedef (elttype
);
361 if (TYPE_STUB (elttype
))
363 fprintf_styled (stream
, metadata_style
.style (), "<incomplete type>");
368 struct type
*range
= elttype
;
369 LONGEST low_bound
, high_bound
;
372 fputs_filtered ("[", stream
);
374 int bound_info
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
375 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
377 /* If we know the size of the set type, we can figure out the
380 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
381 TYPE_HIGH_BOUND (range
) = high_bound
;
386 fputs_styled ("<error value>", metadata_style
.style (), stream
);
390 for (i
= low_bound
; i
<= high_bound
; i
++)
392 int element
= value_bit_index (type
,
393 valaddr
+ embedded_offset
, i
);
398 goto maybe_bad_bstring
;
403 fputs_filtered (", ", stream
);
404 print_type_scalar (range
, i
, stream
);
407 if (i
+ 1 <= high_bound
408 && value_bit_index (type
,
409 valaddr
+ embedded_offset
, ++i
))
413 fputs_filtered ("..", stream
);
414 while (i
+ 1 <= high_bound
415 && value_bit_index (type
,
416 valaddr
+ embedded_offset
,
419 print_type_scalar (range
, j
, stream
);
424 fputs_filtered ("]", stream
);
429 error (_("Invalid pascal type code %d in symbol table."),
437 pascal_value_print_inner (struct value
*val
, struct ui_file
*stream
,
439 const struct value_print_options
*options
)
442 struct type
*type
= check_typedef (value_type (val
));
443 struct gdbarch
*gdbarch
= get_type_arch (type
);
444 enum bfd_endian byte_order
= type_byte_order (type
);
445 unsigned int i
= 0; /* Number of characters printed */
447 struct type
*elttype
;
449 int length_pos
, length_size
, string_pos
;
450 struct type
*char_type
;
453 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
455 switch (TYPE_CODE (type
))
457 case TYPE_CODE_ARRAY
:
459 LONGEST low_bound
, high_bound
;
461 if (get_array_bounds (type
, &low_bound
, &high_bound
))
463 len
= high_bound
- low_bound
+ 1;
464 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
465 eltlen
= TYPE_LENGTH (elttype
);
466 if (options
->prettyformat_arrays
)
468 print_spaces_filtered (2 + 2 * recurse
, stream
);
470 /* If 's' format is used, try to print out as string.
471 If no format is given, print as string if element type
472 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
473 if (options
->format
== 's'
474 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
475 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
476 && options
->format
== 0))
478 /* If requested, look for the first null char and only print
479 elements up to it. */
480 if (options
->stop_print_at_null
)
482 unsigned int temp_len
;
484 /* Look for a NULL char. */
486 extract_unsigned_integer (valaddr
+ temp_len
* eltlen
,
488 && temp_len
< len
&& temp_len
< options
->print_max
;
493 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
494 valaddr
, len
, NULL
, 0, options
);
499 fprintf_filtered (stream
, "{");
500 /* If this is a virtual function table, print the 0th
501 entry specially, and the rest of the members normally. */
502 if (pascal_object_is_vtbl_ptr_type (elttype
))
505 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
511 value_print_array_elements (val
, stream
, recurse
, options
, i
);
512 fprintf_filtered (stream
, "}");
516 /* Array of unspecified length: treat like pointer to first elt. */
517 addr
= value_address (val
);
519 goto print_unpacked_pointer
;
522 if (options
->format
&& options
->format
!= 's')
524 value_print_scalar_formatted (val
, options
, 0, stream
);
527 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
529 /* Print the unmangled name if desired. */
530 /* Print vtable entry - we only get here if we ARE using
531 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
532 /* Extract the address, assume that it is unsigned. */
533 addr
= extract_unsigned_integer (valaddr
,
534 TYPE_LENGTH (type
), byte_order
);
535 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
538 check_typedef (TYPE_TARGET_TYPE (type
));
540 addr
= unpack_pointer (type
, valaddr
);
541 print_unpacked_pointer
:
542 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
544 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
546 /* Try to print what function it points to. */
547 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
551 if (options
->addressprint
&& options
->format
!= 's')
553 fputs_filtered (paddress (gdbarch
, addr
), stream
);
557 /* For a pointer to char or unsigned char, also print the string
558 pointed to, unless pointer is null. */
559 if (((TYPE_LENGTH (elttype
) == 1
560 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
561 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
562 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
563 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
564 && (options
->format
== 0 || options
->format
== 's')
568 fputs_filtered (" ", stream
);
569 /* No wide string yet. */
570 i
= val_print_string (elttype
, NULL
, addr
, -1, stream
, options
);
572 /* Also for pointers to pascal strings. */
573 /* Note: this is Free Pascal specific:
574 as GDB does not recognize stabs pascal strings
575 Pascal strings are mapped to records
576 with lowercase names PM. */
577 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
578 &string_pos
, &char_type
, NULL
)
581 ULONGEST string_length
;
585 fputs_filtered (" ", stream
);
586 buffer
= (gdb_byte
*) xmalloc (length_size
);
587 read_memory (addr
+ length_pos
, buffer
, length_size
);
588 string_length
= extract_unsigned_integer (buffer
, length_size
,
591 i
= val_print_string (char_type
, NULL
,
592 addr
+ string_pos
, string_length
,
595 else if (pascal_object_is_vtbl_member (type
))
597 /* Print vtbl's nicely. */
598 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
);
599 struct bound_minimal_symbol msymbol
=
600 lookup_minimal_symbol_by_pc (vt_address
);
602 /* If 'symbol_print' is set, we did the work above. */
603 if (!options
->symbol_print
604 && (msymbol
.minsym
!= NULL
)
605 && (vt_address
== BMSYMBOL_VALUE_ADDRESS (msymbol
)))
608 fputs_filtered (" ", stream
);
609 fputs_filtered ("<", stream
);
610 fputs_filtered (msymbol
.minsym
->print_name (), stream
);
611 fputs_filtered (">", stream
);
614 if (vt_address
&& options
->vtblprint
)
616 struct value
*vt_val
;
617 struct symbol
*wsym
= NULL
;
621 fputs_filtered (" ", stream
);
623 if (msymbol
.minsym
!= NULL
)
625 const char *search_name
= msymbol
.minsym
->search_name ();
626 wsym
= lookup_symbol_search_name (search_name
, NULL
,
632 wtype
= SYMBOL_TYPE (wsym
);
636 wtype
= TYPE_TARGET_TYPE (type
);
638 vt_val
= value_at (wtype
, vt_address
);
639 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
641 if (options
->prettyformat
)
643 fprintf_filtered (stream
, "\n");
644 print_spaces_filtered (2 + 2 * recurse
, stream
);
653 case TYPE_CODE_FLAGS
:
655 case TYPE_CODE_RANGE
:
659 case TYPE_CODE_ERROR
:
660 case TYPE_CODE_UNDEF
:
663 generic_value_print (val
, stream
, recurse
, options
, &p_decorations
);
666 case TYPE_CODE_UNION
:
667 if (recurse
&& !options
->unionprint
)
669 fprintf_filtered (stream
, "{...}");
673 case TYPE_CODE_STRUCT
:
674 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
676 /* Print the unmangled name if desired. */
677 /* Print vtable entry - we only get here if NOT using
678 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
679 /* Extract the address, assume that it is unsigned. */
680 print_address_demangle
682 extract_unsigned_integer (valaddr
683 + TYPE_FIELD_BITPOS (type
,
684 VTBL_FNADDR_OFFSET
) / 8,
685 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
686 VTBL_FNADDR_OFFSET
)),
692 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
693 &string_pos
, &char_type
, NULL
))
695 len
= extract_unsigned_integer (valaddr
+ length_pos
,
696 length_size
, byte_order
);
697 LA_PRINT_STRING (stream
, char_type
, valaddr
+ string_pos
,
698 len
, NULL
, 0, options
);
701 pascal_object_print_value_fields (type
, valaddr
, 0,
702 value_address (val
), stream
,
703 recurse
, val
, options
,
709 elttype
= TYPE_INDEX_TYPE (type
);
710 elttype
= check_typedef (elttype
);
711 if (TYPE_STUB (elttype
))
713 fprintf_styled (stream
, metadata_style
.style (), "<incomplete type>");
718 struct type
*range
= elttype
;
719 LONGEST low_bound
, high_bound
;
722 fputs_filtered ("[", stream
);
724 int bound_info
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
725 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
727 /* If we know the size of the set type, we can figure out the
730 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
731 TYPE_HIGH_BOUND (range
) = high_bound
;
736 fputs_styled ("<error value>", metadata_style
.style (), stream
);
740 for (i
= low_bound
; i
<= high_bound
; i
++)
742 int element
= value_bit_index (type
, valaddr
, i
);
747 goto maybe_bad_bstring
;
752 fputs_filtered (", ", stream
);
753 print_type_scalar (range
, i
, stream
);
756 if (i
+ 1 <= high_bound
757 && value_bit_index (type
, valaddr
, ++i
))
761 fputs_filtered ("..", stream
);
762 while (i
+ 1 <= high_bound
763 && value_bit_index (type
, valaddr
, ++i
))
765 print_type_scalar (range
, j
, stream
);
770 fputs_filtered ("]", stream
);
775 error (_("Invalid pascal type code %d in symbol table."),
782 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
783 const struct value_print_options
*options
)
785 struct type
*type
= value_type (val
);
786 struct value_print_options opts
= *options
;
790 /* If it is a pointer, indicate what it points to.
792 Print type also if it is a reference.
794 Object pascal: if it is a member pointer, we will take care
795 of that when we print it. */
796 if (TYPE_CODE (type
) == TYPE_CODE_PTR
797 || TYPE_CODE (type
) == TYPE_CODE_REF
)
799 /* Hack: remove (char *) for char strings. Their
800 type is indicated by the quoted string anyway. */
801 if (TYPE_CODE (type
) == TYPE_CODE_PTR
802 && TYPE_NAME (type
) == NULL
803 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
804 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
810 fprintf_filtered (stream
, "(");
811 type_print (type
, "", stream
, -1);
812 fprintf_filtered (stream
, ") ");
815 common_val_print (val
, stream
, 0, &opts
, current_language
);
820 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
821 struct cmd_list_element
*c
, const char *value
)
823 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
827 static struct obstack dont_print_vb_obstack
;
828 static struct obstack dont_print_statmem_obstack
;
830 static void pascal_object_print_static_field (struct value
*,
831 struct ui_file
*, int,
832 const struct value_print_options
*);
834 static void pascal_object_print_value (struct type
*, const gdb_byte
*,
836 CORE_ADDR
, struct ui_file
*, int,
838 const struct value_print_options
*,
841 static void pascal_object_print_value (struct value
*, struct ui_file
*, int,
842 const struct value_print_options
*,
845 /* It was changed to this after 2.4.5. */
846 const char pascal_vtbl_ptr_name
[] =
847 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
849 /* Return truth value for assertion that TYPE is of the type
850 "pointer to virtual function". */
853 pascal_object_is_vtbl_ptr_type (struct type
*type
)
855 const char *type_name
= TYPE_NAME (type
);
857 return (type_name
!= NULL
858 && strcmp (type_name
, pascal_vtbl_ptr_name
) == 0);
861 /* Return truth value for the assertion that TYPE is of the type
862 "pointer to virtual function table". */
865 pascal_object_is_vtbl_member (struct type
*type
)
867 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
869 type
= TYPE_TARGET_TYPE (type
);
870 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
872 type
= TYPE_TARGET_TYPE (type
);
873 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* If not using
875 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* If using thunks. */
877 /* Virtual functions tables are full of pointers
878 to virtual functions. */
879 return pascal_object_is_vtbl_ptr_type (type
);
886 /* Mutually recursive subroutines of pascal_object_print_value and
887 c_val_print to print out a structure's fields:
888 pascal_object_print_value_fields and pascal_object_print_value.
890 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
891 same meanings as in pascal_object_print_value and c_val_print.
893 DONT_PRINT is an array of baseclass types that we
894 should not print, or zero if called from top level. */
897 pascal_object_print_value_fields (struct type
*type
, const gdb_byte
*valaddr
,
899 CORE_ADDR address
, struct ui_file
*stream
,
902 const struct value_print_options
*options
,
903 struct type
**dont_print_vb
,
904 int dont_print_statmem
)
906 int i
, len
, n_baseclasses
;
907 char *last_dont_print
908 = (char *) obstack_next_free (&dont_print_statmem_obstack
);
910 type
= check_typedef (type
);
912 fprintf_filtered (stream
, "{");
913 len
= TYPE_NFIELDS (type
);
914 n_baseclasses
= TYPE_N_BASECLASSES (type
);
916 /* Print out baseclasses such that we don't print
917 duplicates of virtual baseclasses. */
918 if (n_baseclasses
> 0)
919 pascal_object_print_value (type
, valaddr
, offset
, address
,
920 stream
, recurse
+ 1, val
,
921 options
, dont_print_vb
);
923 if (!len
&& n_baseclasses
== 1)
924 fprintf_styled (stream
, metadata_style
.style (), "<No data fields>");
927 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
930 if (dont_print_statmem
== 0)
932 /* If we're at top level, carve out a completely fresh
933 chunk of the obstack and use that until this particular
934 invocation returns. */
935 obstack_finish (&dont_print_statmem_obstack
);
938 for (i
= n_baseclasses
; i
< len
; i
++)
940 /* If requested, skip printing of static fields. */
941 if (!options
->pascal_static_field_print
942 && field_is_static (&TYPE_FIELD (type
, i
)))
945 fprintf_filtered (stream
, ", ");
946 else if (n_baseclasses
> 0)
948 if (options
->prettyformat
)
950 fprintf_filtered (stream
, "\n");
951 print_spaces_filtered (2 + 2 * recurse
, stream
);
952 fputs_filtered ("members of ", stream
);
953 fputs_filtered (TYPE_NAME (type
), stream
);
954 fputs_filtered (": ", stream
);
959 if (options
->prettyformat
)
961 fprintf_filtered (stream
, "\n");
962 print_spaces_filtered (2 + 2 * recurse
, stream
);
966 wrap_here (n_spaces (2 + 2 * recurse
));
969 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
971 if (field_is_static (&TYPE_FIELD (type
, i
)))
973 fputs_filtered ("static ", stream
);
974 fprintf_symbol_filtered (stream
,
975 TYPE_FIELD_NAME (type
, i
),
976 current_language
->la_language
,
977 DMGL_PARAMS
| DMGL_ANSI
);
980 fputs_styled (TYPE_FIELD_NAME (type
, i
),
981 variable_name_style
.style (), stream
);
982 annotate_field_name_end ();
983 fputs_filtered (" = ", stream
);
984 annotate_field_value ();
986 if (!field_is_static (&TYPE_FIELD (type
, i
))
987 && TYPE_FIELD_PACKED (type
, i
))
991 /* Bitfields require special handling, especially due to byte
993 if (TYPE_FIELD_IGNORE (type
, i
))
995 fputs_styled ("<optimized out or zero length>",
996 metadata_style
.style (), stream
);
998 else if (value_bits_synthetic_pointer (val
,
999 TYPE_FIELD_BITPOS (type
,
1001 TYPE_FIELD_BITSIZE (type
,
1004 fputs_styled (_("<synthetic pointer>"),
1005 metadata_style
.style (), stream
);
1009 struct value_print_options opts
= *options
;
1011 v
= value_field_bitfield (type
, i
, valaddr
, offset
, val
);
1014 common_val_print (v
, stream
, recurse
+ 1, &opts
,
1020 if (TYPE_FIELD_IGNORE (type
, i
))
1022 fputs_styled ("<optimized out or zero length>",
1023 metadata_style
.style (), stream
);
1025 else if (field_is_static (&TYPE_FIELD (type
, i
)))
1027 /* struct value *v = value_static_field (type, i);
1031 v
= value_field_bitfield (type
, i
, valaddr
, offset
, val
);
1034 val_print_optimized_out (NULL
, stream
);
1036 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
1041 struct value_print_options opts
= *options
;
1044 /* val_print (TYPE_FIELD_TYPE (type, i),
1045 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
1046 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
1047 stream, format, 0, recurse + 1, pretty); */
1048 val_print (TYPE_FIELD_TYPE (type
, i
),
1049 offset
+ TYPE_FIELD_BITPOS (type
, i
) / 8,
1050 address
, stream
, recurse
+ 1, val
, &opts
,
1054 annotate_field_end ();
1057 if (dont_print_statmem
== 0)
1059 /* Free the space used to deal with the printing
1060 of the members from top level. */
1061 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
1062 dont_print_statmem_obstack
= tmp_obstack
;
1065 if (options
->prettyformat
)
1067 fprintf_filtered (stream
, "\n");
1068 print_spaces_filtered (2 * recurse
, stream
);
1071 fprintf_filtered (stream
, "}");
1074 /* Mutually recursive subroutines of pascal_object_print_value and
1075 pascal_value_print to print out a structure's fields:
1076 pascal_object_print_value_fields and pascal_object_print_value.
1078 VAL, STREAM, RECURSE, and OPTIONS have the same meanings as in
1079 pascal_object_print_value and c_value_print.
1081 DONT_PRINT is an array of baseclass types that we
1082 should not print, or zero if called from top level. */
1085 pascal_object_print_value_fields (struct value
*val
, struct ui_file
*stream
,
1087 const struct value_print_options
*options
,
1088 struct type
**dont_print_vb
,
1089 int dont_print_statmem
)
1091 int i
, len
, n_baseclasses
;
1092 char *last_dont_print
1093 = (char *) obstack_next_free (&dont_print_statmem_obstack
);
1095 struct type
*type
= check_typedef (value_type (val
));
1097 fprintf_filtered (stream
, "{");
1098 len
= TYPE_NFIELDS (type
);
1099 n_baseclasses
= TYPE_N_BASECLASSES (type
);
1101 /* Print out baseclasses such that we don't print
1102 duplicates of virtual baseclasses. */
1103 if (n_baseclasses
> 0)
1104 pascal_object_print_value (val
, stream
, recurse
+ 1,
1105 options
, dont_print_vb
);
1107 if (!len
&& n_baseclasses
== 1)
1108 fprintf_styled (stream
, metadata_style
.style (), "<No data fields>");
1111 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
1112 int fields_seen
= 0;
1113 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
1115 if (dont_print_statmem
== 0)
1117 /* If we're at top level, carve out a completely fresh
1118 chunk of the obstack and use that until this particular
1119 invocation returns. */
1120 obstack_finish (&dont_print_statmem_obstack
);
1123 for (i
= n_baseclasses
; i
< len
; i
++)
1125 /* If requested, skip printing of static fields. */
1126 if (!options
->pascal_static_field_print
1127 && field_is_static (&TYPE_FIELD (type
, i
)))
1130 fprintf_filtered (stream
, ", ");
1131 else if (n_baseclasses
> 0)
1133 if (options
->prettyformat
)
1135 fprintf_filtered (stream
, "\n");
1136 print_spaces_filtered (2 + 2 * recurse
, stream
);
1137 fputs_filtered ("members of ", stream
);
1138 fputs_filtered (TYPE_NAME (type
), stream
);
1139 fputs_filtered (": ", stream
);
1144 if (options
->prettyformat
)
1146 fprintf_filtered (stream
, "\n");
1147 print_spaces_filtered (2 + 2 * recurse
, stream
);
1151 wrap_here (n_spaces (2 + 2 * recurse
));
1154 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
1156 if (field_is_static (&TYPE_FIELD (type
, i
)))
1158 fputs_filtered ("static ", stream
);
1159 fprintf_symbol_filtered (stream
,
1160 TYPE_FIELD_NAME (type
, i
),
1161 current_language
->la_language
,
1162 DMGL_PARAMS
| DMGL_ANSI
);
1165 fputs_styled (TYPE_FIELD_NAME (type
, i
),
1166 variable_name_style
.style (), stream
);
1167 annotate_field_name_end ();
1168 fputs_filtered (" = ", stream
);
1169 annotate_field_value ();
1171 if (!field_is_static (&TYPE_FIELD (type
, i
))
1172 && TYPE_FIELD_PACKED (type
, i
))
1176 /* Bitfields require special handling, especially due to byte
1178 if (TYPE_FIELD_IGNORE (type
, i
))
1180 fputs_styled ("<optimized out or zero length>",
1181 metadata_style
.style (), stream
);
1183 else if (value_bits_synthetic_pointer (val
,
1184 TYPE_FIELD_BITPOS (type
,
1186 TYPE_FIELD_BITSIZE (type
,
1189 fputs_styled (_("<synthetic pointer>"),
1190 metadata_style
.style (), stream
);
1194 struct value_print_options opts
= *options
;
1196 v
= value_field_bitfield (type
, i
, valaddr
, 0, val
);
1199 common_val_print (v
, stream
, recurse
+ 1, &opts
,
1205 if (TYPE_FIELD_IGNORE (type
, i
))
1207 fputs_styled ("<optimized out or zero length>",
1208 metadata_style
.style (), stream
);
1210 else if (field_is_static (&TYPE_FIELD (type
, i
)))
1212 /* struct value *v = value_static_field (type, i);
1216 v
= value_field_bitfield (type
, i
, valaddr
, 0, val
);
1219 val_print_optimized_out (NULL
, stream
);
1221 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
1226 struct value_print_options opts
= *options
;
1230 struct value
*v
= value_primitive_field (val
, 0, i
,
1232 common_val_print (v
, stream
, recurse
+ 1, &opts
,
1236 annotate_field_end ();
1239 if (dont_print_statmem
== 0)
1241 /* Free the space used to deal with the printing
1242 of the members from top level. */
1243 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
1244 dont_print_statmem_obstack
= tmp_obstack
;
1247 if (options
->prettyformat
)
1249 fprintf_filtered (stream
, "\n");
1250 print_spaces_filtered (2 * recurse
, stream
);
1253 fprintf_filtered (stream
, "}");
1256 /* Special val_print routine to avoid printing multiple copies of virtual
1260 pascal_object_print_value (struct type
*type
, const gdb_byte
*valaddr
,
1262 CORE_ADDR address
, struct ui_file
*stream
,
1265 const struct value_print_options
*options
,
1266 struct type
**dont_print_vb
)
1268 struct type
**last_dont_print
1269 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
1270 struct obstack tmp_obstack
= dont_print_vb_obstack
;
1271 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
1273 if (dont_print_vb
== 0)
1275 /* If we're at top level, carve out a completely fresh
1276 chunk of the obstack and use that until this particular
1277 invocation returns. */
1278 /* Bump up the high-water mark. Now alpha is omega. */
1279 obstack_finish (&dont_print_vb_obstack
);
1282 for (i
= 0; i
< n_baseclasses
; i
++)
1284 LONGEST boffset
= 0;
1285 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
1286 const char *basename
= TYPE_NAME (baseclass
);
1287 const gdb_byte
*base_valaddr
= NULL
;
1290 gdb::byte_vector buf
;
1292 if (BASETYPE_VIA_VIRTUAL (type
, i
))
1294 struct type
**first_dont_print
1295 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
1297 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
1301 if (baseclass
== first_dont_print
[j
])
1304 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
1307 thisoffset
= offset
;
1311 boffset
= baseclass_offset (type
, i
, valaddr
, offset
, address
, val
);
1313 catch (const gdb_exception_error
&ex
)
1315 if (ex
.error
== NOT_AVAILABLE_ERROR
)
1323 /* The virtual base class pointer might have been clobbered by the
1324 user program. Make sure that it still points to a valid memory
1327 if (boffset
< 0 || boffset
>= TYPE_LENGTH (type
))
1329 buf
.resize (TYPE_LENGTH (baseclass
));
1331 base_valaddr
= buf
.data ();
1332 if (target_read_memory (address
+ boffset
, buf
.data (),
1333 TYPE_LENGTH (baseclass
)) != 0)
1335 address
= address
+ boffset
;
1340 base_valaddr
= valaddr
;
1343 if (options
->prettyformat
)
1345 fprintf_filtered (stream
, "\n");
1346 print_spaces_filtered (2 * recurse
, stream
);
1348 fputs_filtered ("<", stream
);
1349 /* Not sure what the best notation is in the case where there is no
1352 fputs_filtered (basename
? basename
: "", stream
);
1353 fputs_filtered ("> = ", stream
);
1356 val_print_unavailable (stream
);
1358 val_print_invalid_address (stream
);
1360 pascal_object_print_value_fields (baseclass
, base_valaddr
,
1361 thisoffset
+ boffset
, address
,
1362 stream
, recurse
, val
, options
,
1363 (struct type
**) obstack_base (&dont_print_vb_obstack
),
1365 fputs_filtered (", ", stream
);
1371 if (dont_print_vb
== 0)
1373 /* Free the space used to deal with the printing
1374 of this type from top level. */
1375 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
1376 /* Reset watermark so that we can continue protecting
1377 ourselves from whatever we were protecting ourselves. */
1378 dont_print_vb_obstack
= tmp_obstack
;
1382 /* Special val_print routine to avoid printing multiple copies of virtual
1386 pascal_object_print_value (struct value
*val
, struct ui_file
*stream
,
1388 const struct value_print_options
*options
,
1389 struct type
**dont_print_vb
)
1391 struct type
**last_dont_print
1392 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
1393 struct obstack tmp_obstack
= dont_print_vb_obstack
;
1394 struct type
*type
= check_typedef (value_type (val
));
1395 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
1397 if (dont_print_vb
== 0)
1399 /* If we're at top level, carve out a completely fresh
1400 chunk of the obstack and use that until this particular
1401 invocation returns. */
1402 /* Bump up the high-water mark. Now alpha is omega. */
1403 obstack_finish (&dont_print_vb_obstack
);
1406 for (i
= 0; i
< n_baseclasses
; i
++)
1408 LONGEST boffset
= 0;
1409 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
1410 const char *basename
= TYPE_NAME (baseclass
);
1413 if (BASETYPE_VIA_VIRTUAL (type
, i
))
1415 struct type
**first_dont_print
1416 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
1418 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
1422 if (baseclass
== first_dont_print
[j
])
1425 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
1428 struct value
*base_value
;
1431 base_value
= value_primitive_field (val
, 0, i
, type
);
1433 catch (const gdb_exception_error
&ex
)
1435 if (ex
.error
== NOT_AVAILABLE_ERROR
)
1443 /* The virtual base class pointer might have been clobbered by the
1444 user program. Make sure that it still points to a valid memory
1447 if (boffset
< 0 || boffset
>= TYPE_LENGTH (type
))
1449 CORE_ADDR address
= value_address (val
);
1450 gdb::byte_vector
buf (TYPE_LENGTH (baseclass
));
1452 if (target_read_memory (address
+ boffset
, buf
.data (),
1453 TYPE_LENGTH (baseclass
)) != 0)
1455 base_value
= value_from_contents_and_address (baseclass
,
1458 baseclass
= value_type (base_value
);
1463 if (options
->prettyformat
)
1465 fprintf_filtered (stream
, "\n");
1466 print_spaces_filtered (2 * recurse
, stream
);
1468 fputs_filtered ("<", stream
);
1469 /* Not sure what the best notation is in the case where there is no
1472 fputs_filtered (basename
? basename
: "", stream
);
1473 fputs_filtered ("> = ", stream
);
1476 val_print_unavailable (stream
);
1478 val_print_invalid_address (stream
);
1480 pascal_object_print_value_fields
1481 (base_value
, stream
, recurse
, options
,
1482 (struct type
**) obstack_base (&dont_print_vb_obstack
),
1484 fputs_filtered (", ", stream
);
1490 if (dont_print_vb
== 0)
1492 /* Free the space used to deal with the printing
1493 of this type from top level. */
1494 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
1495 /* Reset watermark so that we can continue protecting
1496 ourselves from whatever we were protecting ourselves. */
1497 dont_print_vb_obstack
= tmp_obstack
;
1501 /* Print value of a static member.
1502 To avoid infinite recursion when printing a class that contains
1503 a static instance of the class, we keep the addresses of all printed
1504 static member classes in an obstack and refuse to print them more
1507 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
1508 have the same meanings as in c_val_print. */
1511 pascal_object_print_static_field (struct value
*val
,
1512 struct ui_file
*stream
,
1514 const struct value_print_options
*options
)
1516 struct type
*type
= value_type (val
);
1517 struct value_print_options opts
;
1519 if (value_entirely_optimized_out (val
))
1521 val_print_optimized_out (val
, stream
);
1525 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
1527 CORE_ADDR
*first_dont_print
, addr
;
1531 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
1532 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
1537 if (value_address (val
) == first_dont_print
[i
])
1540 <same as static member of an already seen type>"),
1541 metadata_style
.style (), stream
);
1546 addr
= value_address (val
);
1547 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
1548 sizeof (CORE_ADDR
));
1550 type
= check_typedef (type
);
1551 pascal_object_print_value_fields (type
,
1552 value_contents_for_printing (val
),
1553 value_embedded_offset (val
),
1556 val
, options
, NULL
, 1);
1562 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
1565 void _initialize_pascal_valprint ();
1567 _initialize_pascal_valprint ()
1569 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
1570 &user_print_options
.pascal_static_field_print
, _("\
1571 Set printing of pascal static members."), _("\
1572 Show printing of pascal static members."), NULL
,
1574 show_pascal_static_field_print
,
1575 &setprintlist
, &showprintlist
);