1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000-2001, 2003, 2005-2012 Free Software Foundation,
6 This file is part of GDB.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* This file is derived from c-valprint.c */
24 #include "gdb_obstack.h"
27 #include "expression.h"
34 #include "typeprint.h"
40 #include "cp-support.h"
41 #include "exceptions.h"
44 /* Decorations for Pascal. */
46 static const struct generic_val_print_decorations p_decorations =
56 /* See val_print for a description of the various parameters of this
57 function; they are identical. */
60 pascal_val_print (struct type *type, const gdb_byte *valaddr,
61 int embedded_offset, CORE_ADDR address,
62 struct ui_file *stream, int recurse,
63 const struct value *original_value,
64 const struct value_print_options *options)
66 struct gdbarch *gdbarch = get_type_arch (type);
67 enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
68 unsigned int i = 0; /* Number of characters printed */
70 LONGEST low_bound, high_bound;
73 int length_pos, length_size, string_pos;
74 struct type *char_type;
79 switch (TYPE_CODE (type))
82 if (get_array_bounds (type, &low_bound, &high_bound))
84 len = high_bound - low_bound + 1;
85 elttype = check_typedef (TYPE_TARGET_TYPE (type));
86 eltlen = TYPE_LENGTH (elttype);
87 if (options->prettyprint_arrays)
89 print_spaces_filtered (2 + 2 * recurse, stream);
91 /* If 's' format is used, try to print out as string.
92 If no format is given, print as string if element type
93 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
94 if (options->format == 's'
95 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
96 && TYPE_CODE (elttype) == TYPE_CODE_CHAR
97 && options->format == 0))
99 /* If requested, look for the first null char and only print
100 elements up to it. */
101 if (options->stop_print_at_null)
103 unsigned int temp_len;
105 /* Look for a NULL char. */
107 extract_unsigned_integer (valaddr + embedded_offset +
108 temp_len * eltlen, eltlen,
110 && temp_len < len && temp_len < options->print_max;
115 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
116 valaddr + embedded_offset, len, NULL, 0,
122 fprintf_filtered (stream, "{");
123 /* If this is a virtual function table, print the 0th
124 entry specially, and the rest of the members normally. */
125 if (pascal_object_is_vtbl_ptr_type (elttype))
128 fprintf_filtered (stream, "%d vtable entries", len - 1);
134 val_print_array_elements (type, valaddr, embedded_offset,
135 address, stream, recurse,
136 original_value, options, i);
137 fprintf_filtered (stream, "}");
141 /* Array of unspecified length: treat like pointer to first elt. */
142 addr = address + embedded_offset;
143 goto print_unpacked_pointer;
146 if (options->format && options->format != 's')
148 val_print_scalar_formatted (type, valaddr, embedded_offset,
149 original_value, options, 0, stream);
152 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
154 /* Print the unmangled name if desired. */
155 /* Print vtable entry - we only get here if we ARE using
156 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
157 /* Extract the address, assume that it is unsigned. */
158 addr = extract_unsigned_integer (valaddr + embedded_offset,
159 TYPE_LENGTH (type), byte_order);
160 print_address_demangle (options, gdbarch, addr, stream, demangle);
163 check_typedef (TYPE_TARGET_TYPE (type));
165 addr = unpack_pointer (type, valaddr + embedded_offset);
166 print_unpacked_pointer:
167 elttype = check_typedef (TYPE_TARGET_TYPE (type));
169 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
171 /* Try to print what function it points to. */
172 print_address_demangle (options, gdbarch, addr, stream, demangle);
176 if (options->addressprint && options->format != 's')
178 fputs_filtered (paddress (gdbarch, addr), stream);
181 /* For a pointer to char or unsigned char, also print the string
182 pointed to, unless pointer is null. */
183 if (((TYPE_LENGTH (elttype) == 1
184 && (TYPE_CODE (elttype) == TYPE_CODE_INT
185 || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
186 || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
187 && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
188 && (options->format == 0 || options->format == 's')
191 /* No wide string yet. */
192 i = val_print_string (elttype, NULL, addr, -1, stream, options);
194 /* Also for pointers to pascal strings. */
195 /* Note: this is Free Pascal specific:
196 as GDB does not recognize stabs pascal strings
197 Pascal strings are mapped to records
198 with lowercase names PM. */
199 if (is_pascal_string_type (elttype, &length_pos, &length_size,
200 &string_pos, &char_type, NULL)
203 ULONGEST string_length;
206 buffer = xmalloc (length_size);
207 read_memory (addr + length_pos, buffer, length_size);
208 string_length = extract_unsigned_integer (buffer, length_size,
211 i = val_print_string (char_type, NULL,
212 addr + string_pos, string_length,
215 else if (pascal_object_is_vtbl_member (type))
217 /* Print vtbl's nicely. */
218 CORE_ADDR vt_address = unpack_pointer (type,
219 valaddr + embedded_offset);
220 struct minimal_symbol *msymbol =
221 lookup_minimal_symbol_by_pc (vt_address);
223 if ((msymbol != NULL)
224 && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
226 fputs_filtered (" <", stream);
227 fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
228 fputs_filtered (">", stream);
230 if (vt_address && options->vtblprint)
232 struct value *vt_val;
233 struct symbol *wsym = (struct symbol *) NULL;
235 struct block *block = (struct block *) NULL;
239 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
240 VAR_DOMAIN, &is_this_fld);
244 wtype = SYMBOL_TYPE (wsym);
248 wtype = TYPE_TARGET_TYPE (type);
250 vt_val = value_at (wtype, vt_address);
251 common_val_print (vt_val, stream, recurse + 1, options,
255 fprintf_filtered (stream, "\n");
256 print_spaces_filtered (2 + 2 * recurse, stream);
265 case TYPE_CODE_FLAGS:
267 case TYPE_CODE_RANGE:
271 case TYPE_CODE_ERROR:
272 case TYPE_CODE_UNDEF:
275 generic_val_print (type, valaddr, embedded_offset, address,
276 stream, recurse, original_value, options,
280 case TYPE_CODE_UNION:
281 if (recurse && !options->unionprint)
283 fprintf_filtered (stream, "{...}");
287 case TYPE_CODE_STRUCT:
288 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
290 /* Print the unmangled name if desired. */
291 /* Print vtable entry - we only get here if NOT using
292 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
293 /* Extract the address, assume that it is unsigned. */
294 print_address_demangle
296 extract_unsigned_integer (valaddr + embedded_offset
297 + TYPE_FIELD_BITPOS (type,
298 VTBL_FNADDR_OFFSET) / 8,
299 TYPE_LENGTH (TYPE_FIELD_TYPE (type,
300 VTBL_FNADDR_OFFSET)),
306 if (is_pascal_string_type (type, &length_pos, &length_size,
307 &string_pos, &char_type, NULL))
309 len = extract_unsigned_integer (valaddr + embedded_offset
310 + length_pos, length_size,
312 LA_PRINT_STRING (stream, char_type,
313 valaddr + embedded_offset + string_pos,
314 len, NULL, 0, options);
317 pascal_object_print_value_fields (type, valaddr, embedded_offset,
318 address, stream, recurse,
319 original_value, options,
324 case TYPE_CODE_BITSTRING:
326 elttype = TYPE_INDEX_TYPE (type);
327 CHECK_TYPEDEF (elttype);
328 if (TYPE_STUB (elttype))
330 fprintf_filtered (stream, "<incomplete type>");
336 struct type *range = elttype;
337 LONGEST low_bound, high_bound;
339 int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
343 fputs_filtered ("B'", stream);
345 fputs_filtered ("[", stream);
347 i = get_discrete_bounds (range, &low_bound, &high_bound);
348 if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
350 /* If we know the size of the set type, we can figure out the
353 high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
354 TYPE_HIGH_BOUND (range) = high_bound;
359 fputs_filtered ("<error value>", stream);
363 for (i = low_bound; i <= high_bound; i++)
365 int element = value_bit_index (type,
366 valaddr + embedded_offset, i);
371 goto maybe_bad_bstring;
374 fprintf_filtered (stream, "%d", element);
378 fputs_filtered (", ", stream);
379 print_type_scalar (range, i, stream);
382 if (i + 1 <= high_bound
383 && value_bit_index (type,
384 valaddr + embedded_offset, ++i))
388 fputs_filtered ("..", stream);
389 while (i + 1 <= high_bound
390 && value_bit_index (type,
391 valaddr + embedded_offset,
394 print_type_scalar (range, j, stream);
400 fputs_filtered ("'", stream);
402 fputs_filtered ("]", stream);
407 error (_("Invalid pascal type code %d in symbol table."),
414 pascal_value_print (struct value *val, struct ui_file *stream,
415 const struct value_print_options *options)
417 struct type *type = value_type (val);
418 struct value_print_options opts = *options;
422 /* If it is a pointer, indicate what it points to.
424 Print type also if it is a reference.
426 Object pascal: if it is a member pointer, we will take care
427 of that when we print it. */
428 if (TYPE_CODE (type) == TYPE_CODE_PTR
429 || TYPE_CODE (type) == TYPE_CODE_REF)
431 /* Hack: remove (char *) for char strings. Their
432 type is indicated by the quoted string anyway. */
433 if (TYPE_CODE (type) == TYPE_CODE_PTR
434 && TYPE_NAME (type) == NULL
435 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
436 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
442 fprintf_filtered (stream, "(");
443 type_print (type, "", stream, -1);
444 fprintf_filtered (stream, ") ");
447 common_val_print (val, stream, 0, &opts, current_language);
452 show_pascal_static_field_print (struct ui_file *file, int from_tty,
453 struct cmd_list_element *c, const char *value)
455 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
459 static struct obstack dont_print_vb_obstack;
460 static struct obstack dont_print_statmem_obstack;
462 static void pascal_object_print_static_field (struct value *,
463 struct ui_file *, int,
464 const struct value_print_options *);
466 static void pascal_object_print_value (struct type *, const gdb_byte *,
468 CORE_ADDR, struct ui_file *, int,
469 const struct value *,
470 const struct value_print_options *,
473 /* It was changed to this after 2.4.5. */
474 const char pascal_vtbl_ptr_name[] =
475 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
477 /* Return truth value for assertion that TYPE is of the type
478 "pointer to virtual function". */
481 pascal_object_is_vtbl_ptr_type (struct type *type)
483 const char *typename = type_name_no_tag (type);
485 return (typename != NULL
486 && strcmp (typename, pascal_vtbl_ptr_name) == 0);
489 /* Return truth value for the assertion that TYPE is of the type
490 "pointer to virtual function table". */
493 pascal_object_is_vtbl_member (struct type *type)
495 if (TYPE_CODE (type) == TYPE_CODE_PTR)
497 type = TYPE_TARGET_TYPE (type);
498 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
500 type = TYPE_TARGET_TYPE (type);
501 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* If not using
503 || TYPE_CODE (type) == TYPE_CODE_PTR) /* If using thunks. */
505 /* Virtual functions tables are full of pointers
506 to virtual functions. */
507 return pascal_object_is_vtbl_ptr_type (type);
514 /* Mutually recursive subroutines of pascal_object_print_value and
515 c_val_print to print out a structure's fields:
516 pascal_object_print_value_fields and pascal_object_print_value.
518 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
519 same meanings as in pascal_object_print_value and c_val_print.
521 DONT_PRINT is an array of baseclass types that we
522 should not print, or zero if called from top level. */
525 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
527 CORE_ADDR address, struct ui_file *stream,
529 const struct value *val,
530 const struct value_print_options *options,
531 struct type **dont_print_vb,
532 int dont_print_statmem)
534 int i, len, n_baseclasses;
535 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
537 CHECK_TYPEDEF (type);
539 fprintf_filtered (stream, "{");
540 len = TYPE_NFIELDS (type);
541 n_baseclasses = TYPE_N_BASECLASSES (type);
543 /* Print out baseclasses such that we don't print
544 duplicates of virtual baseclasses. */
545 if (n_baseclasses > 0)
546 pascal_object_print_value (type, valaddr, offset, address,
547 stream, recurse + 1, val,
548 options, dont_print_vb);
550 if (!len && n_baseclasses == 1)
551 fprintf_filtered (stream, "<No data fields>");
554 struct obstack tmp_obstack = dont_print_statmem_obstack;
557 if (dont_print_statmem == 0)
559 /* If we're at top level, carve out a completely fresh
560 chunk of the obstack and use that until this particular
561 invocation returns. */
562 obstack_finish (&dont_print_statmem_obstack);
565 for (i = n_baseclasses; i < len; i++)
567 /* If requested, skip printing of static fields. */
568 if (!options->pascal_static_field_print
569 && field_is_static (&TYPE_FIELD (type, i)))
572 fprintf_filtered (stream, ", ");
573 else if (n_baseclasses > 0)
577 fprintf_filtered (stream, "\n");
578 print_spaces_filtered (2 + 2 * recurse, stream);
579 fputs_filtered ("members of ", stream);
580 fputs_filtered (type_name_no_tag (type), stream);
581 fputs_filtered (": ", stream);
588 fprintf_filtered (stream, "\n");
589 print_spaces_filtered (2 + 2 * recurse, stream);
593 wrap_here (n_spaces (2 + 2 * recurse));
595 if (options->inspect_it)
597 if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
598 fputs_filtered ("\"( ptr \"", stream);
600 fputs_filtered ("\"( nodef \"", stream);
601 if (field_is_static (&TYPE_FIELD (type, i)))
602 fputs_filtered ("static ", stream);
603 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
605 DMGL_PARAMS | DMGL_ANSI);
606 fputs_filtered ("\" \"", stream);
607 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
609 DMGL_PARAMS | DMGL_ANSI);
610 fputs_filtered ("\") \"", stream);
614 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
616 if (field_is_static (&TYPE_FIELD (type, i)))
617 fputs_filtered ("static ", stream);
618 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
620 DMGL_PARAMS | DMGL_ANSI);
621 annotate_field_name_end ();
622 fputs_filtered (" = ", stream);
623 annotate_field_value ();
626 if (!field_is_static (&TYPE_FIELD (type, i))
627 && TYPE_FIELD_PACKED (type, i))
631 /* Bitfields require special handling, especially due to byte
633 if (TYPE_FIELD_IGNORE (type, i))
635 fputs_filtered ("<optimized out or zero length>", stream);
637 else if (value_bits_synthetic_pointer (val,
638 TYPE_FIELD_BITPOS (type,
640 TYPE_FIELD_BITSIZE (type,
643 fputs_filtered (_("<synthetic pointer>"), stream);
645 else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
646 TYPE_FIELD_BITSIZE (type, i)))
648 val_print_optimized_out (stream);
652 struct value_print_options opts = *options;
654 v = value_field_bitfield (type, i, valaddr, offset, val);
657 common_val_print (v, stream, recurse + 1, &opts,
663 if (TYPE_FIELD_IGNORE (type, i))
665 fputs_filtered ("<optimized out or zero length>", stream);
667 else if (field_is_static (&TYPE_FIELD (type, i)))
669 /* struct value *v = value_static_field (type, i);
673 v = value_field_bitfield (type, i, valaddr, offset, val);
676 val_print_optimized_out (stream);
678 pascal_object_print_static_field (v, stream, recurse + 1,
683 struct value_print_options opts = *options;
686 /* val_print (TYPE_FIELD_TYPE (type, i),
687 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
688 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
689 stream, format, 0, recurse + 1, pretty); */
690 val_print (TYPE_FIELD_TYPE (type, i),
691 valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
692 address, stream, recurse + 1, val, &opts,
696 annotate_field_end ();
699 if (dont_print_statmem == 0)
701 /* Free the space used to deal with the printing
702 of the members from top level. */
703 obstack_free (&dont_print_statmem_obstack, last_dont_print);
704 dont_print_statmem_obstack = tmp_obstack;
709 fprintf_filtered (stream, "\n");
710 print_spaces_filtered (2 * recurse, stream);
713 fprintf_filtered (stream, "}");
716 /* Special val_print routine to avoid printing multiple copies of virtual
720 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
722 CORE_ADDR address, struct ui_file *stream,
724 const struct value *val,
725 const struct value_print_options *options,
726 struct type **dont_print_vb)
728 struct type **last_dont_print
729 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
730 struct obstack tmp_obstack = dont_print_vb_obstack;
731 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
733 if (dont_print_vb == 0)
735 /* If we're at top level, carve out a completely fresh
736 chunk of the obstack and use that until this particular
737 invocation returns. */
738 /* Bump up the high-water mark. Now alpha is omega. */
739 obstack_finish (&dont_print_vb_obstack);
742 for (i = 0; i < n_baseclasses; i++)
745 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
746 const char *basename = type_name_no_tag (baseclass);
747 const gdb_byte *base_valaddr = NULL;
749 volatile struct gdb_exception ex;
752 if (BASETYPE_VIA_VIRTUAL (type, i))
754 struct type **first_dont_print
755 = (struct type **) obstack_base (&dont_print_vb_obstack);
757 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
761 if (baseclass == first_dont_print[j])
764 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
769 TRY_CATCH (ex, RETURN_MASK_ERROR)
771 boffset = baseclass_offset (type, i, valaddr, offset, address, val);
773 if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR)
775 else if (ex.reason < 0)
781 /* The virtual base class pointer might have been clobbered by the
782 user program. Make sure that it still points to a valid memory
785 if (boffset < 0 || boffset >= TYPE_LENGTH (type))
787 /* FIXME (alloc): not safe is baseclass is really really big. */
788 gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
791 if (target_read_memory (address + boffset, buf,
792 TYPE_LENGTH (baseclass)) != 0)
794 address = address + boffset;
799 base_valaddr = valaddr;
804 fprintf_filtered (stream, "\n");
805 print_spaces_filtered (2 * recurse, stream);
807 fputs_filtered ("<", stream);
808 /* Not sure what the best notation is in the case where there is no
811 fputs_filtered (basename ? basename : "", stream);
812 fputs_filtered ("> = ", stream);
815 val_print_unavailable (stream);
817 val_print_invalid_address (stream);
819 pascal_object_print_value_fields (baseclass, base_valaddr,
820 thisoffset + boffset, address,
821 stream, recurse, val, options,
822 (struct type **) obstack_base (&dont_print_vb_obstack),
824 fputs_filtered (", ", stream);
830 if (dont_print_vb == 0)
832 /* Free the space used to deal with the printing
833 of this type from top level. */
834 obstack_free (&dont_print_vb_obstack, last_dont_print);
835 /* Reset watermark so that we can continue protecting
836 ourselves from whatever we were protecting ourselves. */
837 dont_print_vb_obstack = tmp_obstack;
841 /* Print value of a static member.
842 To avoid infinite recursion when printing a class that contains
843 a static instance of the class, we keep the addresses of all printed
844 static member classes in an obstack and refuse to print them more
847 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
848 have the same meanings as in c_val_print. */
851 pascal_object_print_static_field (struct value *val,
852 struct ui_file *stream,
854 const struct value_print_options *options)
856 struct type *type = value_type (val);
857 struct value_print_options opts;
859 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
861 CORE_ADDR *first_dont_print, addr;
865 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
866 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
871 if (value_address (val) == first_dont_print[i])
874 <same as static member of an already seen type>",
880 addr = value_address (val);
881 obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
884 CHECK_TYPEDEF (type);
885 pascal_object_print_value_fields (type,
886 value_contents_for_printing (val),
887 value_embedded_offset (val),
890 val, options, NULL, 1);
896 common_val_print (val, stream, recurse, &opts, current_language);
899 /* -Wmissing-prototypes */
900 extern initialize_file_ftype _initialize_pascal_valprint;
903 _initialize_pascal_valprint (void)
905 add_setshow_boolean_cmd ("pascal_static-members", class_support,
906 &user_print_options.pascal_static_field_print, _("\
907 Set printing of pascal static members."), _("\
908 Show printing of pascal static members."), NULL,
910 show_pascal_static_field_print,
911 &setprintlist, &showprintlist);