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 value
*, struct ui_file
*,
47 const struct value_print_options
*,
50 /* Decorations for Pascal. */
52 static const struct generic_val_print_decorations p_decorations
=
67 pascal_value_print_inner (struct value
*val
, struct ui_file
*stream
,
69 const struct value_print_options
*options
)
72 struct type
*type
= check_typedef (value_type (val
));
73 struct gdbarch
*gdbarch
= get_type_arch (type
);
74 enum bfd_endian byte_order
= type_byte_order (type
);
75 unsigned int i
= 0; /* Number of characters printed */
79 int length_pos
, length_size
, string_pos
;
80 struct type
*char_type
;
83 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
85 switch (TYPE_CODE (type
))
89 LONGEST low_bound
, high_bound
;
91 if (get_array_bounds (type
, &low_bound
, &high_bound
))
93 len
= high_bound
- low_bound
+ 1;
94 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
95 eltlen
= TYPE_LENGTH (elttype
);
96 if (options
->prettyformat_arrays
)
98 print_spaces_filtered (2 + 2 * recurse
, stream
);
100 /* If 's' format is used, try to print out as string.
101 If no format is given, print as string if element type
102 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
103 if (options
->format
== 's'
104 || ((eltlen
== 1 || eltlen
== 2 || eltlen
== 4)
105 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
106 && options
->format
== 0))
108 /* If requested, look for the first null char and only print
109 elements up to it. */
110 if (options
->stop_print_at_null
)
112 unsigned int temp_len
;
114 /* Look for a NULL char. */
116 extract_unsigned_integer (valaddr
+ temp_len
* eltlen
,
118 && temp_len
< len
&& temp_len
< options
->print_max
;
123 LA_PRINT_STRING (stream
, TYPE_TARGET_TYPE (type
),
124 valaddr
, len
, NULL
, 0, options
);
129 fprintf_filtered (stream
, "{");
130 /* If this is a virtual function table, print the 0th
131 entry specially, and the rest of the members normally. */
132 if (pascal_object_is_vtbl_ptr_type (elttype
))
135 fprintf_filtered (stream
, "%d vtable entries", len
- 1);
141 value_print_array_elements (val
, stream
, recurse
, options
, i
);
142 fprintf_filtered (stream
, "}");
146 /* Array of unspecified length: treat like pointer to first elt. */
147 addr
= value_address (val
);
149 goto print_unpacked_pointer
;
152 if (options
->format
&& options
->format
!= 's')
154 value_print_scalar_formatted (val
, options
, 0, stream
);
157 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
159 /* Print the unmangled name if desired. */
160 /* Print vtable entry - we only get here if we ARE using
161 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
162 /* Extract the address, assume that it is unsigned. */
163 addr
= extract_unsigned_integer (valaddr
,
164 TYPE_LENGTH (type
), byte_order
);
165 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
168 check_typedef (TYPE_TARGET_TYPE (type
));
170 addr
= unpack_pointer (type
, valaddr
);
171 print_unpacked_pointer
:
172 elttype
= check_typedef (TYPE_TARGET_TYPE (type
));
174 if (TYPE_CODE (elttype
) == TYPE_CODE_FUNC
)
176 /* Try to print what function it points to. */
177 print_address_demangle (options
, gdbarch
, addr
, stream
, demangle
);
181 if (options
->addressprint
&& options
->format
!= 's')
183 fputs_filtered (paddress (gdbarch
, addr
), stream
);
187 /* For a pointer to char or unsigned char, also print the string
188 pointed to, unless pointer is null. */
189 if (((TYPE_LENGTH (elttype
) == 1
190 && (TYPE_CODE (elttype
) == TYPE_CODE_INT
191 || TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
192 || ((TYPE_LENGTH (elttype
) == 2 || TYPE_LENGTH (elttype
) == 4)
193 && TYPE_CODE (elttype
) == TYPE_CODE_CHAR
))
194 && (options
->format
== 0 || options
->format
== 's')
198 fputs_filtered (" ", stream
);
199 /* No wide string yet. */
200 i
= val_print_string (elttype
, NULL
, addr
, -1, stream
, options
);
202 /* Also for pointers to pascal strings. */
203 /* Note: this is Free Pascal specific:
204 as GDB does not recognize stabs pascal strings
205 Pascal strings are mapped to records
206 with lowercase names PM. */
207 if (is_pascal_string_type (elttype
, &length_pos
, &length_size
,
208 &string_pos
, &char_type
, NULL
)
211 ULONGEST string_length
;
215 fputs_filtered (" ", stream
);
216 buffer
= (gdb_byte
*) xmalloc (length_size
);
217 read_memory (addr
+ length_pos
, buffer
, length_size
);
218 string_length
= extract_unsigned_integer (buffer
, length_size
,
221 i
= val_print_string (char_type
, NULL
,
222 addr
+ string_pos
, string_length
,
225 else if (pascal_object_is_vtbl_member (type
))
227 /* Print vtbl's nicely. */
228 CORE_ADDR vt_address
= unpack_pointer (type
, valaddr
);
229 struct bound_minimal_symbol msymbol
=
230 lookup_minimal_symbol_by_pc (vt_address
);
232 /* If 'symbol_print' is set, we did the work above. */
233 if (!options
->symbol_print
234 && (msymbol
.minsym
!= NULL
)
235 && (vt_address
== BMSYMBOL_VALUE_ADDRESS (msymbol
)))
238 fputs_filtered (" ", stream
);
239 fputs_filtered ("<", stream
);
240 fputs_filtered (msymbol
.minsym
->print_name (), stream
);
241 fputs_filtered (">", stream
);
244 if (vt_address
&& options
->vtblprint
)
246 struct value
*vt_val
;
247 struct symbol
*wsym
= NULL
;
251 fputs_filtered (" ", stream
);
253 if (msymbol
.minsym
!= NULL
)
255 const char *search_name
= msymbol
.minsym
->search_name ();
256 wsym
= lookup_symbol_search_name (search_name
, NULL
,
262 wtype
= SYMBOL_TYPE (wsym
);
266 wtype
= TYPE_TARGET_TYPE (type
);
268 vt_val
= value_at (wtype
, vt_address
);
269 common_val_print (vt_val
, stream
, recurse
+ 1, options
,
271 if (options
->prettyformat
)
273 fprintf_filtered (stream
, "\n");
274 print_spaces_filtered (2 + 2 * recurse
, stream
);
283 case TYPE_CODE_FLAGS
:
285 case TYPE_CODE_RANGE
:
289 case TYPE_CODE_ERROR
:
290 case TYPE_CODE_UNDEF
:
293 generic_value_print (val
, stream
, recurse
, options
, &p_decorations
);
296 case TYPE_CODE_UNION
:
297 if (recurse
&& !options
->unionprint
)
299 fprintf_filtered (stream
, "{...}");
303 case TYPE_CODE_STRUCT
:
304 if (options
->vtblprint
&& pascal_object_is_vtbl_ptr_type (type
))
306 /* Print the unmangled name if desired. */
307 /* Print vtable entry - we only get here if NOT using
308 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
309 /* Extract the address, assume that it is unsigned. */
310 print_address_demangle
312 extract_unsigned_integer (valaddr
313 + TYPE_FIELD_BITPOS (type
,
314 VTBL_FNADDR_OFFSET
) / 8,
315 TYPE_LENGTH (TYPE_FIELD_TYPE (type
,
316 VTBL_FNADDR_OFFSET
)),
322 if (is_pascal_string_type (type
, &length_pos
, &length_size
,
323 &string_pos
, &char_type
, NULL
))
325 len
= extract_unsigned_integer (valaddr
+ length_pos
,
326 length_size
, byte_order
);
327 LA_PRINT_STRING (stream
, char_type
, valaddr
+ string_pos
,
328 len
, NULL
, 0, options
);
331 pascal_object_print_value_fields (val
, stream
, recurse
,
337 elttype
= TYPE_INDEX_TYPE (type
);
338 elttype
= check_typedef (elttype
);
339 if (TYPE_STUB (elttype
))
341 fprintf_styled (stream
, metadata_style
.style (), "<incomplete type>");
346 struct type
*range
= elttype
;
347 LONGEST low_bound
, high_bound
;
350 fputs_filtered ("[", stream
);
352 int bound_info
= get_discrete_bounds (range
, &low_bound
, &high_bound
);
353 if (low_bound
== 0 && high_bound
== -1 && TYPE_LENGTH (type
) > 0)
355 /* If we know the size of the set type, we can figure out the
358 high_bound
= TYPE_LENGTH (type
) * TARGET_CHAR_BIT
- 1;
359 TYPE_HIGH_BOUND (range
) = high_bound
;
364 fputs_styled ("<error value>", metadata_style
.style (), stream
);
368 for (i
= low_bound
; i
<= high_bound
; i
++)
370 int element
= value_bit_index (type
, valaddr
, i
);
375 goto maybe_bad_bstring
;
380 fputs_filtered (", ", stream
);
381 print_type_scalar (range
, i
, stream
);
384 if (i
+ 1 <= high_bound
385 && value_bit_index (type
, valaddr
, ++i
))
389 fputs_filtered ("..", stream
);
390 while (i
+ 1 <= high_bound
391 && value_bit_index (type
, valaddr
, ++i
))
393 print_type_scalar (range
, j
, stream
);
398 fputs_filtered ("]", stream
);
403 error (_("Invalid pascal type code %d in symbol table."),
410 pascal_value_print (struct value
*val
, struct ui_file
*stream
,
411 const struct value_print_options
*options
)
413 struct type
*type
= value_type (val
);
414 struct value_print_options opts
= *options
;
418 /* If it is a pointer, indicate what it points to.
420 Print type also if it is a reference.
422 Object pascal: if it is a member pointer, we will take care
423 of that when we print it. */
424 if (TYPE_CODE (type
) == TYPE_CODE_PTR
425 || TYPE_CODE (type
) == TYPE_CODE_REF
)
427 /* Hack: remove (char *) for char strings. Their
428 type is indicated by the quoted string anyway. */
429 if (TYPE_CODE (type
) == TYPE_CODE_PTR
430 && TYPE_NAME (type
) == NULL
431 && TYPE_NAME (TYPE_TARGET_TYPE (type
)) != NULL
432 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type
)), "char") == 0)
438 fprintf_filtered (stream
, "(");
439 type_print (type
, "", stream
, -1);
440 fprintf_filtered (stream
, ") ");
443 common_val_print (val
, stream
, 0, &opts
, current_language
);
448 show_pascal_static_field_print (struct ui_file
*file
, int from_tty
,
449 struct cmd_list_element
*c
, const char *value
)
451 fprintf_filtered (file
, _("Printing of pascal static members is %s.\n"),
455 static struct obstack dont_print_vb_obstack
;
456 static struct obstack dont_print_statmem_obstack
;
458 static void pascal_object_print_static_field (struct value
*,
459 struct ui_file
*, int,
460 const struct value_print_options
*);
462 static void pascal_object_print_value (struct value
*, struct ui_file
*, int,
463 const struct value_print_options
*,
466 /* It was changed to this after 2.4.5. */
467 const char pascal_vtbl_ptr_name
[] =
468 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
470 /* Return truth value for assertion that TYPE is of the type
471 "pointer to virtual function". */
474 pascal_object_is_vtbl_ptr_type (struct type
*type
)
476 const char *type_name
= TYPE_NAME (type
);
478 return (type_name
!= NULL
479 && strcmp (type_name
, pascal_vtbl_ptr_name
) == 0);
482 /* Return truth value for the assertion that TYPE is of the type
483 "pointer to virtual function table". */
486 pascal_object_is_vtbl_member (struct type
*type
)
488 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
490 type
= TYPE_TARGET_TYPE (type
);
491 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
493 type
= TYPE_TARGET_TYPE (type
);
494 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
/* If not using
496 || TYPE_CODE (type
) == TYPE_CODE_PTR
) /* If using thunks. */
498 /* Virtual functions tables are full of pointers
499 to virtual functions. */
500 return pascal_object_is_vtbl_ptr_type (type
);
507 /* Mutually recursive subroutines of pascal_object_print_value and
508 pascal_value_print to print out a structure's fields:
509 pascal_object_print_value_fields and pascal_object_print_value.
511 VAL, STREAM, RECURSE, and OPTIONS have the same meanings as in
512 pascal_object_print_value and c_value_print.
514 DONT_PRINT is an array of baseclass types that we
515 should not print, or zero if called from top level. */
518 pascal_object_print_value_fields (struct value
*val
, struct ui_file
*stream
,
520 const struct value_print_options
*options
,
521 struct type
**dont_print_vb
,
522 int dont_print_statmem
)
524 int i
, len
, n_baseclasses
;
525 char *last_dont_print
526 = (char *) obstack_next_free (&dont_print_statmem_obstack
);
528 struct type
*type
= check_typedef (value_type (val
));
530 fprintf_filtered (stream
, "{");
531 len
= TYPE_NFIELDS (type
);
532 n_baseclasses
= TYPE_N_BASECLASSES (type
);
534 /* Print out baseclasses such that we don't print
535 duplicates of virtual baseclasses. */
536 if (n_baseclasses
> 0)
537 pascal_object_print_value (val
, stream
, recurse
+ 1,
538 options
, dont_print_vb
);
540 if (!len
&& n_baseclasses
== 1)
541 fprintf_styled (stream
, metadata_style
.style (), "<No data fields>");
544 struct obstack tmp_obstack
= dont_print_statmem_obstack
;
546 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
548 if (dont_print_statmem
== 0)
550 /* If we're at top level, carve out a completely fresh
551 chunk of the obstack and use that until this particular
552 invocation returns. */
553 obstack_finish (&dont_print_statmem_obstack
);
556 for (i
= n_baseclasses
; i
< len
; i
++)
558 /* If requested, skip printing of static fields. */
559 if (!options
->pascal_static_field_print
560 && field_is_static (&TYPE_FIELD (type
, i
)))
563 fprintf_filtered (stream
, ", ");
564 else if (n_baseclasses
> 0)
566 if (options
->prettyformat
)
568 fprintf_filtered (stream
, "\n");
569 print_spaces_filtered (2 + 2 * recurse
, stream
);
570 fputs_filtered ("members of ", stream
);
571 fputs_filtered (TYPE_NAME (type
), stream
);
572 fputs_filtered (": ", stream
);
577 if (options
->prettyformat
)
579 fprintf_filtered (stream
, "\n");
580 print_spaces_filtered (2 + 2 * recurse
, stream
);
584 wrap_here (n_spaces (2 + 2 * recurse
));
587 annotate_field_begin (TYPE_FIELD_TYPE (type
, i
));
589 if (field_is_static (&TYPE_FIELD (type
, i
)))
591 fputs_filtered ("static ", stream
);
592 fprintf_symbol_filtered (stream
,
593 TYPE_FIELD_NAME (type
, i
),
594 current_language
->la_language
,
595 DMGL_PARAMS
| DMGL_ANSI
);
598 fputs_styled (TYPE_FIELD_NAME (type
, i
),
599 variable_name_style
.style (), stream
);
600 annotate_field_name_end ();
601 fputs_filtered (" = ", stream
);
602 annotate_field_value ();
604 if (!field_is_static (&TYPE_FIELD (type
, i
))
605 && TYPE_FIELD_PACKED (type
, i
))
609 /* Bitfields require special handling, especially due to byte
611 if (TYPE_FIELD_IGNORE (type
, i
))
613 fputs_styled ("<optimized out or zero length>",
614 metadata_style
.style (), stream
);
616 else if (value_bits_synthetic_pointer (val
,
617 TYPE_FIELD_BITPOS (type
,
619 TYPE_FIELD_BITSIZE (type
,
622 fputs_styled (_("<synthetic pointer>"),
623 metadata_style
.style (), stream
);
627 struct value_print_options opts
= *options
;
629 v
= value_field_bitfield (type
, i
, valaddr
, 0, val
);
632 common_val_print (v
, stream
, recurse
+ 1, &opts
,
638 if (TYPE_FIELD_IGNORE (type
, i
))
640 fputs_styled ("<optimized out or zero length>",
641 metadata_style
.style (), stream
);
643 else if (field_is_static (&TYPE_FIELD (type
, i
)))
645 /* struct value *v = value_static_field (type, i);
649 v
= value_field_bitfield (type
, i
, valaddr
, 0, val
);
652 val_print_optimized_out (NULL
, stream
);
654 pascal_object_print_static_field (v
, stream
, recurse
+ 1,
659 struct value_print_options opts
= *options
;
663 struct value
*v
= value_primitive_field (val
, 0, i
,
665 common_val_print (v
, stream
, recurse
+ 1, &opts
,
669 annotate_field_end ();
672 if (dont_print_statmem
== 0)
674 /* Free the space used to deal with the printing
675 of the members from top level. */
676 obstack_free (&dont_print_statmem_obstack
, last_dont_print
);
677 dont_print_statmem_obstack
= tmp_obstack
;
680 if (options
->prettyformat
)
682 fprintf_filtered (stream
, "\n");
683 print_spaces_filtered (2 * recurse
, stream
);
686 fprintf_filtered (stream
, "}");
689 /* Special val_print routine to avoid printing multiple copies of virtual
693 pascal_object_print_value (struct value
*val
, struct ui_file
*stream
,
695 const struct value_print_options
*options
,
696 struct type
**dont_print_vb
)
698 struct type
**last_dont_print
699 = (struct type
**) obstack_next_free (&dont_print_vb_obstack
);
700 struct obstack tmp_obstack
= dont_print_vb_obstack
;
701 struct type
*type
= check_typedef (value_type (val
));
702 int i
, n_baseclasses
= TYPE_N_BASECLASSES (type
);
704 if (dont_print_vb
== 0)
706 /* If we're at top level, carve out a completely fresh
707 chunk of the obstack and use that until this particular
708 invocation returns. */
709 /* Bump up the high-water mark. Now alpha is omega. */
710 obstack_finish (&dont_print_vb_obstack
);
713 for (i
= 0; i
< n_baseclasses
; i
++)
716 struct type
*baseclass
= check_typedef (TYPE_BASECLASS (type
, i
));
717 const char *basename
= TYPE_NAME (baseclass
);
720 if (BASETYPE_VIA_VIRTUAL (type
, i
))
722 struct type
**first_dont_print
723 = (struct type
**) obstack_base (&dont_print_vb_obstack
);
725 int j
= (struct type
**) obstack_next_free (&dont_print_vb_obstack
)
729 if (baseclass
== first_dont_print
[j
])
732 obstack_ptr_grow (&dont_print_vb_obstack
, baseclass
);
735 struct value
*base_value
;
738 base_value
= value_primitive_field (val
, 0, i
, type
);
740 catch (const gdb_exception_error
&ex
)
742 base_value
= nullptr;
743 if (ex
.error
== NOT_AVAILABLE_ERROR
)
751 /* The virtual base class pointer might have been clobbered by the
752 user program. Make sure that it still points to a valid memory
755 if (boffset
< 0 || boffset
>= TYPE_LENGTH (type
))
757 CORE_ADDR address
= value_address (val
);
758 gdb::byte_vector
buf (TYPE_LENGTH (baseclass
));
760 if (target_read_memory (address
+ boffset
, buf
.data (),
761 TYPE_LENGTH (baseclass
)) != 0)
763 base_value
= value_from_contents_and_address (baseclass
,
766 baseclass
= value_type (base_value
);
771 if (options
->prettyformat
)
773 fprintf_filtered (stream
, "\n");
774 print_spaces_filtered (2 * recurse
, stream
);
776 fputs_filtered ("<", stream
);
777 /* Not sure what the best notation is in the case where there is no
780 fputs_filtered (basename
? basename
: "", stream
);
781 fputs_filtered ("> = ", stream
);
784 val_print_unavailable (stream
);
786 val_print_invalid_address (stream
);
788 pascal_object_print_value_fields
789 (base_value
, stream
, recurse
, options
,
790 (struct type
**) obstack_base (&dont_print_vb_obstack
),
792 fputs_filtered (", ", stream
);
798 if (dont_print_vb
== 0)
800 /* Free the space used to deal with the printing
801 of this type from top level. */
802 obstack_free (&dont_print_vb_obstack
, last_dont_print
);
803 /* Reset watermark so that we can continue protecting
804 ourselves from whatever we were protecting ourselves. */
805 dont_print_vb_obstack
= tmp_obstack
;
809 /* Print value of a static member.
810 To avoid infinite recursion when printing a class that contains
811 a static instance of the class, we keep the addresses of all printed
812 static member classes in an obstack and refuse to print them more
815 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
816 have the same meanings as in c_val_print. */
819 pascal_object_print_static_field (struct value
*val
,
820 struct ui_file
*stream
,
822 const struct value_print_options
*options
)
824 struct type
*type
= value_type (val
);
825 struct value_print_options opts
;
827 if (value_entirely_optimized_out (val
))
829 val_print_optimized_out (val
, stream
);
833 if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
835 CORE_ADDR
*first_dont_print
, addr
;
839 = (CORE_ADDR
*) obstack_base (&dont_print_statmem_obstack
);
840 i
= (CORE_ADDR
*) obstack_next_free (&dont_print_statmem_obstack
)
845 if (value_address (val
) == first_dont_print
[i
])
848 <same as static member of an already seen type>"),
849 metadata_style
.style (), stream
);
854 addr
= value_address (val
);
855 obstack_grow (&dont_print_statmem_obstack
, (char *) &addr
,
858 type
= check_typedef (type
);
859 pascal_object_print_value_fields (val
, stream
, recurse
,
866 common_val_print (val
, stream
, recurse
, &opts
, current_language
);
869 void _initialize_pascal_valprint ();
871 _initialize_pascal_valprint ()
873 add_setshow_boolean_cmd ("pascal_static-members", class_support
,
874 &user_print_options
.pascal_static_field_print
, _("\
875 Set printing of pascal static members."), _("\
876 Show printing of pascal static members."), NULL
,
878 show_pascal_static_field_print
,
879 &setprintlist
, &showprintlist
);