1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000-2018 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 "common/byte-vector.h"
44 /* Decorations for Pascal. */
46 static const struct generic_val_print_decorations p_decorations =
58 /* See val_print for a description of the various parameters of this
59 function; they are identical. */
62 pascal_val_print (struct type *type,
63 int embedded_offset, CORE_ADDR address,
64 struct ui_file *stream, int recurse,
65 struct value *original_value,
66 const struct value_print_options *options)
68 struct gdbarch *gdbarch = get_type_arch (type);
69 enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
70 unsigned int i = 0; /* Number of characters printed */
72 LONGEST low_bound, high_bound;
75 int length_pos, length_size, string_pos;
76 struct type *char_type;
79 const gdb_byte *valaddr = value_contents_for_printing (original_value);
81 type = check_typedef (type);
82 switch (TYPE_CODE (type))
85 if (get_array_bounds (type, &low_bound, &high_bound))
87 len = high_bound - low_bound + 1;
88 elttype = check_typedef (TYPE_TARGET_TYPE (type));
89 eltlen = TYPE_LENGTH (elttype);
90 if (options->prettyformat_arrays)
92 print_spaces_filtered (2 + 2 * recurse, stream);
94 /* If 's' format is used, try to print out as string.
95 If no format is given, print as string if element type
96 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
97 if (options->format == 's'
98 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
99 && TYPE_CODE (elttype) == TYPE_CODE_CHAR
100 && options->format == 0))
102 /* If requested, look for the first null char and only print
103 elements up to it. */
104 if (options->stop_print_at_null)
106 unsigned int temp_len;
108 /* Look for a NULL char. */
110 extract_unsigned_integer (valaddr + embedded_offset +
111 temp_len * eltlen, eltlen,
113 && temp_len < len && temp_len < options->print_max;
118 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
119 valaddr + embedded_offset, len, NULL, 0,
125 fprintf_filtered (stream, "{");
126 /* If this is a virtual function table, print the 0th
127 entry specially, and the rest of the members normally. */
128 if (pascal_object_is_vtbl_ptr_type (elttype))
131 fprintf_filtered (stream, "%d vtable entries", len - 1);
137 val_print_array_elements (type, embedded_offset,
138 address, stream, recurse,
139 original_value, options, i);
140 fprintf_filtered (stream, "}");
144 /* Array of unspecified length: treat like pointer to first elt. */
145 addr = address + embedded_offset;
146 goto print_unpacked_pointer;
149 if (options->format && options->format != 's')
151 val_print_scalar_formatted (type, embedded_offset,
152 original_value, options, 0, stream);
155 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
157 /* Print the unmangled name if desired. */
158 /* Print vtable entry - we only get here if we ARE using
159 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
160 /* Extract the address, assume that it is unsigned. */
161 addr = extract_unsigned_integer (valaddr + embedded_offset,
162 TYPE_LENGTH (type), byte_order);
163 print_address_demangle (options, gdbarch, addr, stream, demangle);
166 check_typedef (TYPE_TARGET_TYPE (type));
168 addr = unpack_pointer (type, valaddr + embedded_offset);
169 print_unpacked_pointer:
170 elttype = check_typedef (TYPE_TARGET_TYPE (type));
172 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
174 /* Try to print what function it points to. */
175 print_address_demangle (options, gdbarch, addr, stream, demangle);
179 if (options->addressprint && options->format != 's')
181 fputs_filtered (paddress (gdbarch, addr), stream);
185 /* For a pointer to char or unsigned char, also print the string
186 pointed to, unless pointer is null. */
187 if (((TYPE_LENGTH (elttype) == 1
188 && (TYPE_CODE (elttype) == TYPE_CODE_INT
189 || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
190 || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
191 && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
192 && (options->format == 0 || options->format == 's')
196 fputs_filtered (" ", stream);
197 /* No wide string yet. */
198 i = val_print_string (elttype, NULL, addr, -1, stream, options);
200 /* Also for pointers to pascal strings. */
201 /* Note: this is Free Pascal specific:
202 as GDB does not recognize stabs pascal strings
203 Pascal strings are mapped to records
204 with lowercase names PM. */
205 if (is_pascal_string_type (elttype, &length_pos, &length_size,
206 &string_pos, &char_type, NULL)
209 ULONGEST string_length;
213 fputs_filtered (" ", stream);
214 buffer = (gdb_byte *) xmalloc (length_size);
215 read_memory (addr + length_pos, buffer, length_size);
216 string_length = extract_unsigned_integer (buffer, length_size,
219 i = val_print_string (char_type, NULL,
220 addr + string_pos, string_length,
223 else if (pascal_object_is_vtbl_member (type))
225 /* Print vtbl's nicely. */
226 CORE_ADDR vt_address = unpack_pointer (type,
227 valaddr + embedded_offset);
228 struct bound_minimal_symbol msymbol =
229 lookup_minimal_symbol_by_pc (vt_address);
231 /* If 'symbol_print' is set, we did the work above. */
232 if (!options->symbol_print
233 && (msymbol.minsym != NULL)
234 && (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
237 fputs_filtered (" ", stream);
238 fputs_filtered ("<", stream);
239 fputs_filtered (MSYMBOL_PRINT_NAME (msymbol.minsym), stream);
240 fputs_filtered (">", stream);
243 if (vt_address && options->vtblprint)
245 struct value *vt_val;
246 struct symbol *wsym = NULL;
248 struct block *block = NULL;
251 fputs_filtered (" ", stream);
253 if (msymbol.minsym != NULL)
255 const char *search_name
256 = MSYMBOL_SEARCH_NAME (msymbol.minsym);
257 wsym = lookup_symbol_search_name (search_name, block,
263 wtype = SYMBOL_TYPE (wsym);
267 wtype = TYPE_TARGET_TYPE (type);
269 vt_val = value_at (wtype, vt_address);
270 common_val_print (vt_val, stream, recurse + 1, options,
272 if (options->prettyformat)
274 fprintf_filtered (stream, "\n");
275 print_spaces_filtered (2 + 2 * recurse, stream);
284 case TYPE_CODE_FLAGS:
286 case TYPE_CODE_RANGE:
290 case TYPE_CODE_ERROR:
291 case TYPE_CODE_UNDEF:
294 generic_val_print (type, embedded_offset, address,
295 stream, recurse, original_value, options,
299 case TYPE_CODE_UNION:
300 if (recurse && !options->unionprint)
302 fprintf_filtered (stream, "{...}");
306 case TYPE_CODE_STRUCT:
307 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
309 /* Print the unmangled name if desired. */
310 /* Print vtable entry - we only get here if NOT using
311 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
312 /* Extract the address, assume that it is unsigned. */
313 print_address_demangle
315 extract_unsigned_integer (valaddr + embedded_offset
316 + TYPE_FIELD_BITPOS (type,
317 VTBL_FNADDR_OFFSET) / 8,
318 TYPE_LENGTH (TYPE_FIELD_TYPE (type,
319 VTBL_FNADDR_OFFSET)),
325 if (is_pascal_string_type (type, &length_pos, &length_size,
326 &string_pos, &char_type, NULL))
328 len = extract_unsigned_integer (valaddr + embedded_offset
329 + length_pos, length_size,
331 LA_PRINT_STRING (stream, char_type,
332 valaddr + embedded_offset + string_pos,
333 len, NULL, 0, options);
336 pascal_object_print_value_fields (type, valaddr, embedded_offset,
337 address, stream, recurse,
338 original_value, options,
344 elttype = TYPE_INDEX_TYPE (type);
345 elttype = check_typedef (elttype);
346 if (TYPE_STUB (elttype))
348 fprintf_filtered (stream, "<incomplete type>");
354 struct type *range = elttype;
355 LONGEST low_bound, high_bound;
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;
390 fputs_filtered (", ", stream);
391 print_type_scalar (range, i, stream);
394 if (i + 1 <= high_bound
395 && value_bit_index (type,
396 valaddr + embedded_offset, ++i))
400 fputs_filtered ("..", stream);
401 while (i + 1 <= high_bound
402 && value_bit_index (type,
403 valaddr + embedded_offset,
406 print_type_scalar (range, j, stream);
411 fputs_filtered ("]", stream);
416 error (_("Invalid pascal type code %d in symbol table."),
423 pascal_value_print (struct value *val, struct ui_file *stream,
424 const struct value_print_options *options)
426 struct type *type = value_type (val);
427 struct value_print_options opts = *options;
431 /* If it is a pointer, indicate what it points to.
433 Print type also if it is a reference.
435 Object pascal: if it is a member pointer, we will take care
436 of that when we print it. */
437 if (TYPE_CODE (type) == TYPE_CODE_PTR
438 || TYPE_CODE (type) == TYPE_CODE_REF)
440 /* Hack: remove (char *) for char strings. Their
441 type is indicated by the quoted string anyway. */
442 if (TYPE_CODE (type) == TYPE_CODE_PTR
443 && TYPE_NAME (type) == NULL
444 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
445 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
451 fprintf_filtered (stream, "(");
452 type_print (type, "", stream, -1);
453 fprintf_filtered (stream, ") ");
456 common_val_print (val, stream, 0, &opts, current_language);
461 show_pascal_static_field_print (struct ui_file *file, int from_tty,
462 struct cmd_list_element *c, const char *value)
464 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
468 static struct obstack dont_print_vb_obstack;
469 static struct obstack dont_print_statmem_obstack;
471 static void pascal_object_print_static_field (struct value *,
472 struct ui_file *, int,
473 const struct value_print_options *);
475 static void pascal_object_print_value (struct type *, const gdb_byte *,
477 CORE_ADDR, struct ui_file *, int,
479 const struct value_print_options *,
482 /* It was changed to this after 2.4.5. */
483 const char pascal_vtbl_ptr_name[] =
484 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
486 /* Return truth value for assertion that TYPE is of the type
487 "pointer to virtual function". */
490 pascal_object_is_vtbl_ptr_type (struct type *type)
492 const char *type_name = TYPE_NAME (type);
494 return (type_name != NULL
495 && strcmp (type_name, pascal_vtbl_ptr_name) == 0);
498 /* Return truth value for the assertion that TYPE is of the type
499 "pointer to virtual function table". */
502 pascal_object_is_vtbl_member (struct type *type)
504 if (TYPE_CODE (type) == TYPE_CODE_PTR)
506 type = TYPE_TARGET_TYPE (type);
507 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
509 type = TYPE_TARGET_TYPE (type);
510 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* If not using
512 || TYPE_CODE (type) == TYPE_CODE_PTR) /* If using thunks. */
514 /* Virtual functions tables are full of pointers
515 to virtual functions. */
516 return pascal_object_is_vtbl_ptr_type (type);
523 /* Mutually recursive subroutines of pascal_object_print_value and
524 c_val_print to print out a structure's fields:
525 pascal_object_print_value_fields and pascal_object_print_value.
527 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
528 same meanings as in pascal_object_print_value and c_val_print.
530 DONT_PRINT is an array of baseclass types that we
531 should not print, or zero if called from top level. */
534 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
536 CORE_ADDR address, struct ui_file *stream,
539 const struct value_print_options *options,
540 struct type **dont_print_vb,
541 int dont_print_statmem)
543 int i, len, n_baseclasses;
544 char *last_dont_print
545 = (char *) obstack_next_free (&dont_print_statmem_obstack);
547 type = check_typedef (type);
549 fprintf_filtered (stream, "{");
550 len = TYPE_NFIELDS (type);
551 n_baseclasses = TYPE_N_BASECLASSES (type);
553 /* Print out baseclasses such that we don't print
554 duplicates of virtual baseclasses. */
555 if (n_baseclasses > 0)
556 pascal_object_print_value (type, valaddr, offset, address,
557 stream, recurse + 1, val,
558 options, dont_print_vb);
560 if (!len && n_baseclasses == 1)
561 fprintf_filtered (stream, "<No data fields>");
564 struct obstack tmp_obstack = dont_print_statmem_obstack;
567 if (dont_print_statmem == 0)
569 /* If we're at top level, carve out a completely fresh
570 chunk of the obstack and use that until this particular
571 invocation returns. */
572 obstack_finish (&dont_print_statmem_obstack);
575 for (i = n_baseclasses; i < len; i++)
577 /* If requested, skip printing of static fields. */
578 if (!options->pascal_static_field_print
579 && field_is_static (&TYPE_FIELD (type, i)))
582 fprintf_filtered (stream, ", ");
583 else if (n_baseclasses > 0)
585 if (options->prettyformat)
587 fprintf_filtered (stream, "\n");
588 print_spaces_filtered (2 + 2 * recurse, stream);
589 fputs_filtered ("members of ", stream);
590 fputs_filtered (TYPE_NAME (type), stream);
591 fputs_filtered (": ", stream);
596 if (options->prettyformat)
598 fprintf_filtered (stream, "\n");
599 print_spaces_filtered (2 + 2 * recurse, stream);
603 wrap_here (n_spaces (2 + 2 * recurse));
606 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
608 if (field_is_static (&TYPE_FIELD (type, i)))
609 fputs_filtered ("static ", stream);
610 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
612 DMGL_PARAMS | DMGL_ANSI);
613 annotate_field_name_end ();
614 fputs_filtered (" = ", stream);
615 annotate_field_value ();
617 if (!field_is_static (&TYPE_FIELD (type, i))
618 && TYPE_FIELD_PACKED (type, i))
622 /* Bitfields require special handling, especially due to byte
624 if (TYPE_FIELD_IGNORE (type, i))
626 fputs_filtered ("<optimized out or zero length>", stream);
628 else if (value_bits_synthetic_pointer (val,
629 TYPE_FIELD_BITPOS (type,
631 TYPE_FIELD_BITSIZE (type,
634 fputs_filtered (_("<synthetic pointer>"), stream);
638 struct value_print_options opts = *options;
640 v = value_field_bitfield (type, i, valaddr, offset, val);
643 common_val_print (v, stream, recurse + 1, &opts,
649 if (TYPE_FIELD_IGNORE (type, i))
651 fputs_filtered ("<optimized out or zero length>", stream);
653 else if (field_is_static (&TYPE_FIELD (type, i)))
655 /* struct value *v = value_static_field (type, i);
659 v = value_field_bitfield (type, i, valaddr, offset, val);
662 val_print_optimized_out (NULL, stream);
664 pascal_object_print_static_field (v, stream, recurse + 1,
669 struct value_print_options opts = *options;
672 /* val_print (TYPE_FIELD_TYPE (type, i),
673 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
674 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
675 stream, format, 0, recurse + 1, pretty); */
676 val_print (TYPE_FIELD_TYPE (type, i),
677 offset + TYPE_FIELD_BITPOS (type, i) / 8,
678 address, stream, recurse + 1, val, &opts,
682 annotate_field_end ();
685 if (dont_print_statmem == 0)
687 /* Free the space used to deal with the printing
688 of the members from top level. */
689 obstack_free (&dont_print_statmem_obstack, last_dont_print);
690 dont_print_statmem_obstack = tmp_obstack;
693 if (options->prettyformat)
695 fprintf_filtered (stream, "\n");
696 print_spaces_filtered (2 * recurse, stream);
699 fprintf_filtered (stream, "}");
702 /* Special val_print routine to avoid printing multiple copies of virtual
706 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
708 CORE_ADDR address, struct ui_file *stream,
711 const struct value_print_options *options,
712 struct type **dont_print_vb)
714 struct type **last_dont_print
715 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
716 struct obstack tmp_obstack = dont_print_vb_obstack;
717 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
719 if (dont_print_vb == 0)
721 /* If we're at top level, carve out a completely fresh
722 chunk of the obstack and use that until this particular
723 invocation returns. */
724 /* Bump up the high-water mark. Now alpha is omega. */
725 obstack_finish (&dont_print_vb_obstack);
728 for (i = 0; i < n_baseclasses; i++)
731 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
732 const char *basename = TYPE_NAME (baseclass);
733 const gdb_byte *base_valaddr = NULL;
736 gdb::byte_vector buf;
738 if (BASETYPE_VIA_VIRTUAL (type, i))
740 struct type **first_dont_print
741 = (struct type **) obstack_base (&dont_print_vb_obstack);
743 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
747 if (baseclass == first_dont_print[j])
750 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
757 boffset = baseclass_offset (type, i, valaddr, offset, address, val);
759 CATCH (ex, RETURN_MASK_ERROR)
761 if (ex.error == NOT_AVAILABLE_ERROR)
770 /* The virtual base class pointer might have been clobbered by the
771 user program. Make sure that it still points to a valid memory
774 if (boffset < 0 || boffset >= TYPE_LENGTH (type))
776 buf.resize (TYPE_LENGTH (baseclass));
778 base_valaddr = buf.data ();
779 if (target_read_memory (address + boffset, buf.data (),
780 TYPE_LENGTH (baseclass)) != 0)
782 address = address + boffset;
787 base_valaddr = valaddr;
790 if (options->prettyformat)
792 fprintf_filtered (stream, "\n");
793 print_spaces_filtered (2 * recurse, stream);
795 fputs_filtered ("<", stream);
796 /* Not sure what the best notation is in the case where there is no
799 fputs_filtered (basename ? basename : "", stream);
800 fputs_filtered ("> = ", stream);
803 val_print_unavailable (stream);
805 val_print_invalid_address (stream);
807 pascal_object_print_value_fields (baseclass, base_valaddr,
808 thisoffset + boffset, address,
809 stream, recurse, val, options,
810 (struct type **) obstack_base (&dont_print_vb_obstack),
812 fputs_filtered (", ", stream);
818 if (dont_print_vb == 0)
820 /* Free the space used to deal with the printing
821 of this type from top level. */
822 obstack_free (&dont_print_vb_obstack, last_dont_print);
823 /* Reset watermark so that we can continue protecting
824 ourselves from whatever we were protecting ourselves. */
825 dont_print_vb_obstack = tmp_obstack;
829 /* Print value of a static member.
830 To avoid infinite recursion when printing a class that contains
831 a static instance of the class, we keep the addresses of all printed
832 static member classes in an obstack and refuse to print them more
835 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
836 have the same meanings as in c_val_print. */
839 pascal_object_print_static_field (struct value *val,
840 struct ui_file *stream,
842 const struct value_print_options *options)
844 struct type *type = value_type (val);
845 struct value_print_options opts;
847 if (value_entirely_optimized_out (val))
849 val_print_optimized_out (val, stream);
853 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
855 CORE_ADDR *first_dont_print, addr;
859 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
860 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
865 if (value_address (val) == first_dont_print[i])
868 <same as static member of an already seen type>",
874 addr = value_address (val);
875 obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
878 type = check_typedef (type);
879 pascal_object_print_value_fields (type,
880 value_contents_for_printing (val),
881 value_embedded_offset (val),
884 val, options, NULL, 1);
890 common_val_print (val, stream, recurse, &opts, current_language);
894 _initialize_pascal_valprint (void)
896 add_setshow_boolean_cmd ("pascal_static-members", class_support,
897 &user_print_options.pascal_static_field_print, _("\
898 Set printing of pascal static members."), _("\
899 Show printing of pascal static members."), NULL,
901 show_pascal_static_field_print,
902 &setprintlist, &showprintlist);