1 /* Support for printing Pascal values for GDB, the GNU debugger.
3 Copyright (C) 2000-2014 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"
40 #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->prettyformat_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);
182 /* For a pointer to char or unsigned char, also print the string
183 pointed to, unless pointer is null. */
184 if (((TYPE_LENGTH (elttype) == 1
185 && (TYPE_CODE (elttype) == TYPE_CODE_INT
186 || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
187 || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
188 && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
189 && (options->format == 0 || options->format == 's')
193 fputs_filtered (" ", stream);
194 /* No wide string yet. */
195 i = val_print_string (elttype, NULL, addr, -1, stream, options);
197 /* Also for pointers to pascal strings. */
198 /* Note: this is Free Pascal specific:
199 as GDB does not recognize stabs pascal strings
200 Pascal strings are mapped to records
201 with lowercase names PM. */
202 if (is_pascal_string_type (elttype, &length_pos, &length_size,
203 &string_pos, &char_type, NULL)
206 ULONGEST string_length;
210 fputs_filtered (" ", stream);
211 buffer = xmalloc (length_size);
212 read_memory (addr + length_pos, buffer, length_size);
213 string_length = extract_unsigned_integer (buffer, length_size,
216 i = val_print_string (char_type, NULL,
217 addr + string_pos, string_length,
220 else if (pascal_object_is_vtbl_member (type))
222 /* Print vtbl's nicely. */
223 CORE_ADDR vt_address = unpack_pointer (type,
224 valaddr + embedded_offset);
225 struct bound_minimal_symbol msymbol =
226 lookup_minimal_symbol_by_pc (vt_address);
228 /* If 'symbol_print' is set, we did the work above. */
229 if (!options->symbol_print
230 && (msymbol.minsym != NULL)
231 && (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
234 fputs_filtered (" ", stream);
235 fputs_filtered ("<", stream);
236 fputs_filtered (MSYMBOL_PRINT_NAME (msymbol.minsym), stream);
237 fputs_filtered (">", stream);
240 if (vt_address && options->vtblprint)
242 struct value *vt_val;
243 struct symbol *wsym = (struct symbol *) NULL;
245 struct block *block = (struct block *) NULL;
246 struct field_of_this_result is_this_fld;
249 fputs_filtered (" ", stream);
251 if (msymbol.minsym != NULL)
252 wsym = lookup_symbol (MSYMBOL_LINKAGE_NAME (msymbol.minsym),
254 VAR_DOMAIN, &is_this_fld);
258 wtype = SYMBOL_TYPE (wsym);
262 wtype = TYPE_TARGET_TYPE (type);
264 vt_val = value_at (wtype, vt_address);
265 common_val_print (vt_val, stream, recurse + 1, options,
267 if (options->prettyformat)
269 fprintf_filtered (stream, "\n");
270 print_spaces_filtered (2 + 2 * recurse, stream);
279 case TYPE_CODE_FLAGS:
281 case TYPE_CODE_RANGE:
285 case TYPE_CODE_ERROR:
286 case TYPE_CODE_UNDEF:
289 generic_val_print (type, valaddr, embedded_offset, address,
290 stream, recurse, original_value, options,
294 case TYPE_CODE_UNION:
295 if (recurse && !options->unionprint)
297 fprintf_filtered (stream, "{...}");
301 case TYPE_CODE_STRUCT:
302 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
304 /* Print the unmangled name if desired. */
305 /* Print vtable entry - we only get here if NOT using
306 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
307 /* Extract the address, assume that it is unsigned. */
308 print_address_demangle
310 extract_unsigned_integer (valaddr + embedded_offset
311 + TYPE_FIELD_BITPOS (type,
312 VTBL_FNADDR_OFFSET) / 8,
313 TYPE_LENGTH (TYPE_FIELD_TYPE (type,
314 VTBL_FNADDR_OFFSET)),
320 if (is_pascal_string_type (type, &length_pos, &length_size,
321 &string_pos, &char_type, NULL))
323 len = extract_unsigned_integer (valaddr + embedded_offset
324 + length_pos, length_size,
326 LA_PRINT_STRING (stream, char_type,
327 valaddr + embedded_offset + string_pos,
328 len, NULL, 0, options);
331 pascal_object_print_value_fields (type, valaddr, embedded_offset,
332 address, stream, recurse,
333 original_value, options,
339 elttype = TYPE_INDEX_TYPE (type);
340 CHECK_TYPEDEF (elttype);
341 if (TYPE_STUB (elttype))
343 fprintf_filtered (stream, "<incomplete type>");
349 struct type *range = elttype;
350 LONGEST low_bound, high_bound;
354 fputs_filtered ("[", stream);
356 i = get_discrete_bounds (range, &low_bound, &high_bound);
357 if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
359 /* If we know the size of the set type, we can figure out the
362 high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
363 TYPE_HIGH_BOUND (range) = high_bound;
368 fputs_filtered ("<error value>", stream);
372 for (i = low_bound; i <= high_bound; i++)
374 int element = value_bit_index (type,
375 valaddr + embedded_offset, i);
380 goto maybe_bad_bstring;
385 fputs_filtered (", ", stream);
386 print_type_scalar (range, i, stream);
389 if (i + 1 <= high_bound
390 && value_bit_index (type,
391 valaddr + embedded_offset, ++i))
395 fputs_filtered ("..", stream);
396 while (i + 1 <= high_bound
397 && value_bit_index (type,
398 valaddr + embedded_offset,
401 print_type_scalar (range, j, stream);
406 fputs_filtered ("]", stream);
411 error (_("Invalid pascal type code %d in symbol table."),
418 pascal_value_print (struct value *val, struct ui_file *stream,
419 const struct value_print_options *options)
421 struct type *type = value_type (val);
422 struct value_print_options opts = *options;
426 /* If it is a pointer, indicate what it points to.
428 Print type also if it is a reference.
430 Object pascal: if it is a member pointer, we will take care
431 of that when we print it. */
432 if (TYPE_CODE (type) == TYPE_CODE_PTR
433 || TYPE_CODE (type) == TYPE_CODE_REF)
435 /* Hack: remove (char *) for char strings. Their
436 type is indicated by the quoted string anyway. */
437 if (TYPE_CODE (type) == TYPE_CODE_PTR
438 && TYPE_NAME (type) == NULL
439 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
440 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
446 fprintf_filtered (stream, "(");
447 type_print (type, "", stream, -1);
448 fprintf_filtered (stream, ") ");
451 common_val_print (val, stream, 0, &opts, current_language);
456 show_pascal_static_field_print (struct ui_file *file, int from_tty,
457 struct cmd_list_element *c, const char *value)
459 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
463 static struct obstack dont_print_vb_obstack;
464 static struct obstack dont_print_statmem_obstack;
466 static void pascal_object_print_static_field (struct value *,
467 struct ui_file *, int,
468 const struct value_print_options *);
470 static void pascal_object_print_value (struct type *, const gdb_byte *,
472 CORE_ADDR, struct ui_file *, int,
473 const struct value *,
474 const struct value_print_options *,
477 /* It was changed to this after 2.4.5. */
478 const char pascal_vtbl_ptr_name[] =
479 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
481 /* Return truth value for assertion that TYPE is of the type
482 "pointer to virtual function". */
485 pascal_object_is_vtbl_ptr_type (struct type *type)
487 const char *typename = type_name_no_tag (type);
489 return (typename != NULL
490 && strcmp (typename, pascal_vtbl_ptr_name) == 0);
493 /* Return truth value for the assertion that TYPE is of the type
494 "pointer to virtual function table". */
497 pascal_object_is_vtbl_member (struct type *type)
499 if (TYPE_CODE (type) == TYPE_CODE_PTR)
501 type = TYPE_TARGET_TYPE (type);
502 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
504 type = TYPE_TARGET_TYPE (type);
505 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* If not using
507 || TYPE_CODE (type) == TYPE_CODE_PTR) /* If using thunks. */
509 /* Virtual functions tables are full of pointers
510 to virtual functions. */
511 return pascal_object_is_vtbl_ptr_type (type);
518 /* Mutually recursive subroutines of pascal_object_print_value and
519 c_val_print to print out a structure's fields:
520 pascal_object_print_value_fields and pascal_object_print_value.
522 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
523 same meanings as in pascal_object_print_value and c_val_print.
525 DONT_PRINT is an array of baseclass types that we
526 should not print, or zero if called from top level. */
529 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
531 CORE_ADDR address, struct ui_file *stream,
533 const struct value *val,
534 const struct value_print_options *options,
535 struct type **dont_print_vb,
536 int dont_print_statmem)
538 int i, len, n_baseclasses;
539 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
541 CHECK_TYPEDEF (type);
543 fprintf_filtered (stream, "{");
544 len = TYPE_NFIELDS (type);
545 n_baseclasses = TYPE_N_BASECLASSES (type);
547 /* Print out baseclasses such that we don't print
548 duplicates of virtual baseclasses. */
549 if (n_baseclasses > 0)
550 pascal_object_print_value (type, valaddr, offset, address,
551 stream, recurse + 1, val,
552 options, dont_print_vb);
554 if (!len && n_baseclasses == 1)
555 fprintf_filtered (stream, "<No data fields>");
558 struct obstack tmp_obstack = dont_print_statmem_obstack;
561 if (dont_print_statmem == 0)
563 /* If we're at top level, carve out a completely fresh
564 chunk of the obstack and use that until this particular
565 invocation returns. */
566 obstack_finish (&dont_print_statmem_obstack);
569 for (i = n_baseclasses; i < len; i++)
571 /* If requested, skip printing of static fields. */
572 if (!options->pascal_static_field_print
573 && field_is_static (&TYPE_FIELD (type, i)))
576 fprintf_filtered (stream, ", ");
577 else if (n_baseclasses > 0)
579 if (options->prettyformat)
581 fprintf_filtered (stream, "\n");
582 print_spaces_filtered (2 + 2 * recurse, stream);
583 fputs_filtered ("members of ", stream);
584 fputs_filtered (type_name_no_tag (type), stream);
585 fputs_filtered (": ", stream);
590 if (options->prettyformat)
592 fprintf_filtered (stream, "\n");
593 print_spaces_filtered (2 + 2 * recurse, stream);
597 wrap_here (n_spaces (2 + 2 * recurse));
600 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
602 if (field_is_static (&TYPE_FIELD (type, i)))
603 fputs_filtered ("static ", stream);
604 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
606 DMGL_PARAMS | DMGL_ANSI);
607 annotate_field_name_end ();
608 fputs_filtered (" = ", stream);
609 annotate_field_value ();
611 if (!field_is_static (&TYPE_FIELD (type, i))
612 && TYPE_FIELD_PACKED (type, i))
616 /* Bitfields require special handling, especially due to byte
618 if (TYPE_FIELD_IGNORE (type, i))
620 fputs_filtered ("<optimized out or zero length>", stream);
622 else if (value_bits_synthetic_pointer (val,
623 TYPE_FIELD_BITPOS (type,
625 TYPE_FIELD_BITSIZE (type,
628 fputs_filtered (_("<synthetic pointer>"), stream);
632 struct value_print_options opts = *options;
634 v = value_field_bitfield (type, i, valaddr, offset, val);
637 common_val_print (v, stream, recurse + 1, &opts,
643 if (TYPE_FIELD_IGNORE (type, i))
645 fputs_filtered ("<optimized out or zero length>", stream);
647 else if (field_is_static (&TYPE_FIELD (type, i)))
649 /* struct value *v = value_static_field (type, i);
653 v = value_field_bitfield (type, i, valaddr, offset, val);
656 val_print_optimized_out (NULL, stream);
658 pascal_object_print_static_field (v, stream, recurse + 1,
663 struct value_print_options opts = *options;
666 /* val_print (TYPE_FIELD_TYPE (type, i),
667 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
668 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
669 stream, format, 0, recurse + 1, pretty); */
670 val_print (TYPE_FIELD_TYPE (type, i),
671 valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
672 address, stream, recurse + 1, val, &opts,
676 annotate_field_end ();
679 if (dont_print_statmem == 0)
681 /* Free the space used to deal with the printing
682 of the members from top level. */
683 obstack_free (&dont_print_statmem_obstack, last_dont_print);
684 dont_print_statmem_obstack = tmp_obstack;
687 if (options->prettyformat)
689 fprintf_filtered (stream, "\n");
690 print_spaces_filtered (2 * recurse, stream);
693 fprintf_filtered (stream, "}");
696 /* Special val_print routine to avoid printing multiple copies of virtual
700 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
702 CORE_ADDR address, struct ui_file *stream,
704 const struct value *val,
705 const struct value_print_options *options,
706 struct type **dont_print_vb)
708 struct type **last_dont_print
709 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
710 struct obstack tmp_obstack = dont_print_vb_obstack;
711 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
713 if (dont_print_vb == 0)
715 /* If we're at top level, carve out a completely fresh
716 chunk of the obstack and use that until this particular
717 invocation returns. */
718 /* Bump up the high-water mark. Now alpha is omega. */
719 obstack_finish (&dont_print_vb_obstack);
722 for (i = 0; i < n_baseclasses; i++)
725 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
726 const char *basename = type_name_no_tag (baseclass);
727 const gdb_byte *base_valaddr = NULL;
729 volatile struct gdb_exception ex;
732 if (BASETYPE_VIA_VIRTUAL (type, i))
734 struct type **first_dont_print
735 = (struct type **) obstack_base (&dont_print_vb_obstack);
737 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
741 if (baseclass == first_dont_print[j])
744 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
749 TRY_CATCH (ex, RETURN_MASK_ERROR)
751 boffset = baseclass_offset (type, i, valaddr, offset, address, val);
753 if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR)
755 else if (ex.reason < 0)
761 /* The virtual base class pointer might have been clobbered by the
762 user program. Make sure that it still points to a valid memory
765 if (boffset < 0 || boffset >= TYPE_LENGTH (type))
768 struct cleanup *back_to;
770 buf = xmalloc (TYPE_LENGTH (baseclass));
771 back_to = make_cleanup (xfree, buf);
774 if (target_read_memory (address + boffset, buf,
775 TYPE_LENGTH (baseclass)) != 0)
777 address = address + boffset;
780 do_cleanups (back_to);
783 base_valaddr = valaddr;
786 if (options->prettyformat)
788 fprintf_filtered (stream, "\n");
789 print_spaces_filtered (2 * recurse, stream);
791 fputs_filtered ("<", stream);
792 /* Not sure what the best notation is in the case where there is no
795 fputs_filtered (basename ? basename : "", stream);
796 fputs_filtered ("> = ", stream);
799 val_print_unavailable (stream);
801 val_print_invalid_address (stream);
803 pascal_object_print_value_fields (baseclass, base_valaddr,
804 thisoffset + boffset, address,
805 stream, recurse, val, options,
806 (struct type **) obstack_base (&dont_print_vb_obstack),
808 fputs_filtered (", ", stream);
814 if (dont_print_vb == 0)
816 /* Free the space used to deal with the printing
817 of this type from top level. */
818 obstack_free (&dont_print_vb_obstack, last_dont_print);
819 /* Reset watermark so that we can continue protecting
820 ourselves from whatever we were protecting ourselves. */
821 dont_print_vb_obstack = tmp_obstack;
825 /* Print value of a static member.
826 To avoid infinite recursion when printing a class that contains
827 a static instance of the class, we keep the addresses of all printed
828 static member classes in an obstack and refuse to print them more
831 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
832 have the same meanings as in c_val_print. */
835 pascal_object_print_static_field (struct value *val,
836 struct ui_file *stream,
838 const struct value_print_options *options)
840 struct type *type = value_type (val);
841 struct value_print_options opts;
843 if (value_entirely_optimized_out (val))
845 val_print_optimized_out (val, stream);
849 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
851 CORE_ADDR *first_dont_print, addr;
855 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
856 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
861 if (value_address (val) == first_dont_print[i])
864 <same as static member of an already seen type>",
870 addr = value_address (val);
871 obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
874 CHECK_TYPEDEF (type);
875 pascal_object_print_value_fields (type,
876 value_contents_for_printing (val),
877 value_embedded_offset (val),
880 val, options, NULL, 1);
886 common_val_print (val, stream, recurse, &opts, current_language);
889 /* -Wmissing-prototypes */
890 extern initialize_file_ftype _initialize_pascal_valprint;
893 _initialize_pascal_valprint (void)
895 add_setshow_boolean_cmd ("pascal_static-members", class_support,
896 &user_print_options.pascal_static_field_print, _("\
897 Set printing of pascal static members."), _("\
898 Show printing of pascal static members."), NULL,
900 show_pascal_static_field_print,
901 &setprintlist, &showprintlist);