77d97213fa03fa0aa179ffe3662af949005aee32
[deliverable/binutils-gdb.git] / gdb / p-valprint.c
1 /* Support for printing Pascal values for GDB, the GNU debugger.
2
3 Copyright (C) 2000-2001, 2003, 2005-2012 Free Software Foundation,
4 Inc.
5
6 This file is part of GDB.
7
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.
12
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.
17
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/>. */
20
21 /* This file is derived from c-valprint.c */
22
23 #include "defs.h"
24 #include "gdb_obstack.h"
25 #include "symtab.h"
26 #include "gdbtypes.h"
27 #include "expression.h"
28 #include "value.h"
29 #include "command.h"
30 #include "gdbcmd.h"
31 #include "gdbcore.h"
32 #include "demangle.h"
33 #include "valprint.h"
34 #include "typeprint.h"
35 #include "language.h"
36 #include "target.h"
37 #include "annotate.h"
38 #include "p-lang.h"
39 #include "cp-abi.h"
40 #include "cp-support.h"
41 #include "exceptions.h"
42 \f
43
44 /* Decorations for Pascal. */
45
46 static const struct generic_val_print_decorations p_decorations =
47 {
48 "",
49 " + ",
50 " * I",
51 "true",
52 "false",
53 "void"
54 };
55
56 /* See val_print for a description of the various parameters of this
57 function; they are identical. */
58
59 void
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)
65 {
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 */
69 unsigned len;
70 LONGEST low_bound, high_bound;
71 struct type *elttype;
72 unsigned eltlen;
73 int length_pos, length_size, string_pos;
74 struct type *char_type;
75 LONGEST val;
76 CORE_ADDR addr;
77 int want_space = 0;
78
79 CHECK_TYPEDEF (type);
80 switch (TYPE_CODE (type))
81 {
82 case TYPE_CODE_ARRAY:
83 if (get_array_bounds (type, &low_bound, &high_bound))
84 {
85 len = high_bound - low_bound + 1;
86 elttype = check_typedef (TYPE_TARGET_TYPE (type));
87 eltlen = TYPE_LENGTH (elttype);
88 if (options->prettyprint_arrays)
89 {
90 print_spaces_filtered (2 + 2 * recurse, stream);
91 }
92 /* If 's' format is used, try to print out as string.
93 If no format is given, print as string if element type
94 is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
95 if (options->format == 's'
96 || ((eltlen == 1 || eltlen == 2 || eltlen == 4)
97 && TYPE_CODE (elttype) == TYPE_CODE_CHAR
98 && options->format == 0))
99 {
100 /* If requested, look for the first null char and only print
101 elements up to it. */
102 if (options->stop_print_at_null)
103 {
104 unsigned int temp_len;
105
106 /* Look for a NULL char. */
107 for (temp_len = 0;
108 extract_unsigned_integer (valaddr + embedded_offset +
109 temp_len * eltlen, eltlen,
110 byte_order)
111 && temp_len < len && temp_len < options->print_max;
112 temp_len++);
113 len = temp_len;
114 }
115
116 LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
117 valaddr + embedded_offset, len, NULL, 0,
118 options);
119 i = len;
120 }
121 else
122 {
123 fprintf_filtered (stream, "{");
124 /* If this is a virtual function table, print the 0th
125 entry specially, and the rest of the members normally. */
126 if (pascal_object_is_vtbl_ptr_type (elttype))
127 {
128 i = 1;
129 fprintf_filtered (stream, "%d vtable entries", len - 1);
130 }
131 else
132 {
133 i = 0;
134 }
135 val_print_array_elements (type, valaddr, embedded_offset,
136 address, stream, recurse,
137 original_value, options, i);
138 fprintf_filtered (stream, "}");
139 }
140 break;
141 }
142 /* Array of unspecified length: treat like pointer to first elt. */
143 addr = address + embedded_offset;
144 goto print_unpacked_pointer;
145
146 case TYPE_CODE_PTR:
147 if (options->format && options->format != 's')
148 {
149 val_print_scalar_formatted (type, valaddr, embedded_offset,
150 original_value, options, 0, stream);
151 break;
152 }
153 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
154 {
155 /* Print the unmangled name if desired. */
156 /* Print vtable entry - we only get here if we ARE using
157 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
158 /* Extract the address, assume that it is unsigned. */
159 addr = extract_unsigned_integer (valaddr + embedded_offset,
160 TYPE_LENGTH (type), byte_order);
161 print_address_demangle (options, gdbarch, addr, stream, demangle);
162 break;
163 }
164 check_typedef (TYPE_TARGET_TYPE (type));
165
166 addr = unpack_pointer (type, valaddr + embedded_offset);
167 print_unpacked_pointer:
168 elttype = check_typedef (TYPE_TARGET_TYPE (type));
169
170 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
171 {
172 /* Try to print what function it points to. */
173 print_address_demangle (options, gdbarch, addr, stream, demangle);
174 return;
175 }
176
177 if (options->addressprint && options->format != 's')
178 {
179 fputs_filtered (paddress (gdbarch, addr), stream);
180 want_space = 1;
181 }
182
183 /* For a pointer to char or unsigned char, also print the string
184 pointed to, unless pointer is null. */
185 if (((TYPE_LENGTH (elttype) == 1
186 && (TYPE_CODE (elttype) == TYPE_CODE_INT
187 || TYPE_CODE (elttype) == TYPE_CODE_CHAR))
188 || ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
189 && TYPE_CODE (elttype) == TYPE_CODE_CHAR))
190 && (options->format == 0 || options->format == 's')
191 && addr != 0)
192 {
193 if (want_space)
194 fputs_filtered (" ", stream);
195 /* No wide string yet. */
196 i = val_print_string (elttype, NULL, addr, -1, stream, options);
197 }
198 /* Also for pointers to pascal strings. */
199 /* Note: this is Free Pascal specific:
200 as GDB does not recognize stabs pascal strings
201 Pascal strings are mapped to records
202 with lowercase names PM. */
203 if (is_pascal_string_type (elttype, &length_pos, &length_size,
204 &string_pos, &char_type, NULL)
205 && addr != 0)
206 {
207 ULONGEST string_length;
208 void *buffer;
209
210 if (want_space)
211 fputs_filtered (" ", stream);
212 buffer = xmalloc (length_size);
213 read_memory (addr + length_pos, buffer, length_size);
214 string_length = extract_unsigned_integer (buffer, length_size,
215 byte_order);
216 xfree (buffer);
217 i = val_print_string (char_type, NULL,
218 addr + string_pos, string_length,
219 stream, options);
220 }
221 else if (pascal_object_is_vtbl_member (type))
222 {
223 /* Print vtbl's nicely. */
224 CORE_ADDR vt_address = unpack_pointer (type,
225 valaddr + embedded_offset);
226 struct minimal_symbol *msymbol =
227 lookup_minimal_symbol_by_pc (vt_address);
228
229 /* If 'symbol_print' is set, we did the work above. */
230 if (!options->symbol_print
231 && (msymbol != NULL)
232 && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
233 {
234 if (want_space)
235 fputs_filtered (" ", stream);
236 fputs_filtered ("<", stream);
237 fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
238 fputs_filtered (">", stream);
239 want_space = 1;
240 }
241 if (vt_address && options->vtblprint)
242 {
243 struct value *vt_val;
244 struct symbol *wsym = (struct symbol *) NULL;
245 struct type *wtype;
246 struct block *block = (struct block *) NULL;
247 int is_this_fld;
248
249 if (want_space)
250 fputs_filtered (" ", stream);
251
252 if (msymbol != NULL)
253 wsym = lookup_symbol (SYMBOL_LINKAGE_NAME (msymbol), block,
254 VAR_DOMAIN, &is_this_fld);
255
256 if (wsym)
257 {
258 wtype = SYMBOL_TYPE (wsym);
259 }
260 else
261 {
262 wtype = TYPE_TARGET_TYPE (type);
263 }
264 vt_val = value_at (wtype, vt_address);
265 common_val_print (vt_val, stream, recurse + 1, options,
266 current_language);
267 if (options->pretty)
268 {
269 fprintf_filtered (stream, "\n");
270 print_spaces_filtered (2 + 2 * recurse, stream);
271 }
272 }
273 }
274
275 return;
276
277 case TYPE_CODE_REF:
278 case TYPE_CODE_ENUM:
279 case TYPE_CODE_FLAGS:
280 case TYPE_CODE_FUNC:
281 case TYPE_CODE_RANGE:
282 case TYPE_CODE_INT:
283 case TYPE_CODE_FLT:
284 case TYPE_CODE_VOID:
285 case TYPE_CODE_ERROR:
286 case TYPE_CODE_UNDEF:
287 case TYPE_CODE_BOOL:
288 case TYPE_CODE_CHAR:
289 generic_val_print (type, valaddr, embedded_offset, address,
290 stream, recurse, original_value, options,
291 &p_decorations);
292 break;
293
294 case TYPE_CODE_UNION:
295 if (recurse && !options->unionprint)
296 {
297 fprintf_filtered (stream, "{...}");
298 break;
299 }
300 /* Fall through. */
301 case TYPE_CODE_STRUCT:
302 if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
303 {
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
309 (options, gdbarch,
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)),
315 byte_order),
316 stream, demangle);
317 }
318 else
319 {
320 if (is_pascal_string_type (type, &length_pos, &length_size,
321 &string_pos, &char_type, NULL))
322 {
323 len = extract_unsigned_integer (valaddr + embedded_offset
324 + length_pos, length_size,
325 byte_order);
326 LA_PRINT_STRING (stream, char_type,
327 valaddr + embedded_offset + string_pos,
328 len, NULL, 0, options);
329 }
330 else
331 pascal_object_print_value_fields (type, valaddr, embedded_offset,
332 address, stream, recurse,
333 original_value, options,
334 NULL, 0);
335 }
336 break;
337
338 case TYPE_CODE_BITSTRING:
339 case TYPE_CODE_SET:
340 elttype = TYPE_INDEX_TYPE (type);
341 CHECK_TYPEDEF (elttype);
342 if (TYPE_STUB (elttype))
343 {
344 fprintf_filtered (stream, "<incomplete type>");
345 gdb_flush (stream);
346 break;
347 }
348 else
349 {
350 struct type *range = elttype;
351 LONGEST low_bound, high_bound;
352 int i;
353 int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
354 int need_comma = 0;
355
356 if (is_bitstring)
357 fputs_filtered ("B'", stream);
358 else
359 fputs_filtered ("[", stream);
360
361 i = get_discrete_bounds (range, &low_bound, &high_bound);
362 if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
363 {
364 /* If we know the size of the set type, we can figure out the
365 maximum value. */
366 i = 0;
367 high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
368 TYPE_HIGH_BOUND (range) = high_bound;
369 }
370 maybe_bad_bstring:
371 if (i < 0)
372 {
373 fputs_filtered ("<error value>", stream);
374 goto done;
375 }
376
377 for (i = low_bound; i <= high_bound; i++)
378 {
379 int element = value_bit_index (type,
380 valaddr + embedded_offset, i);
381
382 if (element < 0)
383 {
384 i = element;
385 goto maybe_bad_bstring;
386 }
387 if (is_bitstring)
388 fprintf_filtered (stream, "%d", element);
389 else if (element)
390 {
391 if (need_comma)
392 fputs_filtered (", ", stream);
393 print_type_scalar (range, i, stream);
394 need_comma = 1;
395
396 if (i + 1 <= high_bound
397 && value_bit_index (type,
398 valaddr + embedded_offset, ++i))
399 {
400 int j = i;
401
402 fputs_filtered ("..", stream);
403 while (i + 1 <= high_bound
404 && value_bit_index (type,
405 valaddr + embedded_offset,
406 ++i))
407 j = i;
408 print_type_scalar (range, j, stream);
409 }
410 }
411 }
412 done:
413 if (is_bitstring)
414 fputs_filtered ("'", stream);
415 else
416 fputs_filtered ("]", stream);
417 }
418 break;
419
420 default:
421 error (_("Invalid pascal type code %d in symbol table."),
422 TYPE_CODE (type));
423 }
424 gdb_flush (stream);
425 }
426 \f
427 void
428 pascal_value_print (struct value *val, struct ui_file *stream,
429 const struct value_print_options *options)
430 {
431 struct type *type = value_type (val);
432 struct value_print_options opts = *options;
433
434 opts.deref_ref = 1;
435
436 /* If it is a pointer, indicate what it points to.
437
438 Print type also if it is a reference.
439
440 Object pascal: if it is a member pointer, we will take care
441 of that when we print it. */
442 if (TYPE_CODE (type) == TYPE_CODE_PTR
443 || TYPE_CODE (type) == TYPE_CODE_REF)
444 {
445 /* Hack: remove (char *) for char strings. Their
446 type is indicated by the quoted string anyway. */
447 if (TYPE_CODE (type) == TYPE_CODE_PTR
448 && TYPE_NAME (type) == NULL
449 && TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
450 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
451 {
452 /* Print nothing. */
453 }
454 else
455 {
456 fprintf_filtered (stream, "(");
457 type_print (type, "", stream, -1);
458 fprintf_filtered (stream, ") ");
459 }
460 }
461 common_val_print (val, stream, 0, &opts, current_language);
462 }
463
464
465 static void
466 show_pascal_static_field_print (struct ui_file *file, int from_tty,
467 struct cmd_list_element *c, const char *value)
468 {
469 fprintf_filtered (file, _("Printing of pascal static members is %s.\n"),
470 value);
471 }
472
473 static struct obstack dont_print_vb_obstack;
474 static struct obstack dont_print_statmem_obstack;
475
476 static void pascal_object_print_static_field (struct value *,
477 struct ui_file *, int,
478 const struct value_print_options *);
479
480 static void pascal_object_print_value (struct type *, const gdb_byte *,
481 int,
482 CORE_ADDR, struct ui_file *, int,
483 const struct value *,
484 const struct value_print_options *,
485 struct type **);
486
487 /* It was changed to this after 2.4.5. */
488 const char pascal_vtbl_ptr_name[] =
489 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
490
491 /* Return truth value for assertion that TYPE is of the type
492 "pointer to virtual function". */
493
494 int
495 pascal_object_is_vtbl_ptr_type (struct type *type)
496 {
497 const char *typename = type_name_no_tag (type);
498
499 return (typename != NULL
500 && strcmp (typename, pascal_vtbl_ptr_name) == 0);
501 }
502
503 /* Return truth value for the assertion that TYPE is of the type
504 "pointer to virtual function table". */
505
506 int
507 pascal_object_is_vtbl_member (struct type *type)
508 {
509 if (TYPE_CODE (type) == TYPE_CODE_PTR)
510 {
511 type = TYPE_TARGET_TYPE (type);
512 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
513 {
514 type = TYPE_TARGET_TYPE (type);
515 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* If not using
516 thunks. */
517 || TYPE_CODE (type) == TYPE_CODE_PTR) /* If using thunks. */
518 {
519 /* Virtual functions tables are full of pointers
520 to virtual functions. */
521 return pascal_object_is_vtbl_ptr_type (type);
522 }
523 }
524 }
525 return 0;
526 }
527
528 /* Mutually recursive subroutines of pascal_object_print_value and
529 c_val_print to print out a structure's fields:
530 pascal_object_print_value_fields and pascal_object_print_value.
531
532 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and OPTIONS have the
533 same meanings as in pascal_object_print_value and c_val_print.
534
535 DONT_PRINT is an array of baseclass types that we
536 should not print, or zero if called from top level. */
537
538 void
539 pascal_object_print_value_fields (struct type *type, const gdb_byte *valaddr,
540 int offset,
541 CORE_ADDR address, struct ui_file *stream,
542 int recurse,
543 const struct value *val,
544 const struct value_print_options *options,
545 struct type **dont_print_vb,
546 int dont_print_statmem)
547 {
548 int i, len, n_baseclasses;
549 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
550
551 CHECK_TYPEDEF (type);
552
553 fprintf_filtered (stream, "{");
554 len = TYPE_NFIELDS (type);
555 n_baseclasses = TYPE_N_BASECLASSES (type);
556
557 /* Print out baseclasses such that we don't print
558 duplicates of virtual baseclasses. */
559 if (n_baseclasses > 0)
560 pascal_object_print_value (type, valaddr, offset, address,
561 stream, recurse + 1, val,
562 options, dont_print_vb);
563
564 if (!len && n_baseclasses == 1)
565 fprintf_filtered (stream, "<No data fields>");
566 else
567 {
568 struct obstack tmp_obstack = dont_print_statmem_obstack;
569 int fields_seen = 0;
570
571 if (dont_print_statmem == 0)
572 {
573 /* If we're at top level, carve out a completely fresh
574 chunk of the obstack and use that until this particular
575 invocation returns. */
576 obstack_finish (&dont_print_statmem_obstack);
577 }
578
579 for (i = n_baseclasses; i < len; i++)
580 {
581 /* If requested, skip printing of static fields. */
582 if (!options->pascal_static_field_print
583 && field_is_static (&TYPE_FIELD (type, i)))
584 continue;
585 if (fields_seen)
586 fprintf_filtered (stream, ", ");
587 else if (n_baseclasses > 0)
588 {
589 if (options->pretty)
590 {
591 fprintf_filtered (stream, "\n");
592 print_spaces_filtered (2 + 2 * recurse, stream);
593 fputs_filtered ("members of ", stream);
594 fputs_filtered (type_name_no_tag (type), stream);
595 fputs_filtered (": ", stream);
596 }
597 }
598 fields_seen = 1;
599
600 if (options->pretty)
601 {
602 fprintf_filtered (stream, "\n");
603 print_spaces_filtered (2 + 2 * recurse, stream);
604 }
605 else
606 {
607 wrap_here (n_spaces (2 + 2 * recurse));
608 }
609 if (options->inspect_it)
610 {
611 if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
612 fputs_filtered ("\"( ptr \"", stream);
613 else
614 fputs_filtered ("\"( nodef \"", stream);
615 if (field_is_static (&TYPE_FIELD (type, i)))
616 fputs_filtered ("static ", stream);
617 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
618 language_cplus,
619 DMGL_PARAMS | DMGL_ANSI);
620 fputs_filtered ("\" \"", stream);
621 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
622 language_cplus,
623 DMGL_PARAMS | DMGL_ANSI);
624 fputs_filtered ("\") \"", stream);
625 }
626 else
627 {
628 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
629
630 if (field_is_static (&TYPE_FIELD (type, i)))
631 fputs_filtered ("static ", stream);
632 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
633 language_cplus,
634 DMGL_PARAMS | DMGL_ANSI);
635 annotate_field_name_end ();
636 fputs_filtered (" = ", stream);
637 annotate_field_value ();
638 }
639
640 if (!field_is_static (&TYPE_FIELD (type, i))
641 && TYPE_FIELD_PACKED (type, i))
642 {
643 struct value *v;
644
645 /* Bitfields require special handling, especially due to byte
646 order problems. */
647 if (TYPE_FIELD_IGNORE (type, i))
648 {
649 fputs_filtered ("<optimized out or zero length>", stream);
650 }
651 else if (value_bits_synthetic_pointer (val,
652 TYPE_FIELD_BITPOS (type,
653 i),
654 TYPE_FIELD_BITSIZE (type,
655 i)))
656 {
657 fputs_filtered (_("<synthetic pointer>"), stream);
658 }
659 else if (!value_bits_valid (val, TYPE_FIELD_BITPOS (type, i),
660 TYPE_FIELD_BITSIZE (type, i)))
661 {
662 val_print_optimized_out (stream);
663 }
664 else
665 {
666 struct value_print_options opts = *options;
667
668 v = value_field_bitfield (type, i, valaddr, offset, val);
669
670 opts.deref_ref = 0;
671 common_val_print (v, stream, recurse + 1, &opts,
672 current_language);
673 }
674 }
675 else
676 {
677 if (TYPE_FIELD_IGNORE (type, i))
678 {
679 fputs_filtered ("<optimized out or zero length>", stream);
680 }
681 else if (field_is_static (&TYPE_FIELD (type, i)))
682 {
683 /* struct value *v = value_static_field (type, i);
684 v4.17 specific. */
685 struct value *v;
686
687 v = value_field_bitfield (type, i, valaddr, offset, val);
688
689 if (v == NULL)
690 val_print_optimized_out (stream);
691 else
692 pascal_object_print_static_field (v, stream, recurse + 1,
693 options);
694 }
695 else
696 {
697 struct value_print_options opts = *options;
698
699 opts.deref_ref = 0;
700 /* val_print (TYPE_FIELD_TYPE (type, i),
701 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
702 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
703 stream, format, 0, recurse + 1, pretty); */
704 val_print (TYPE_FIELD_TYPE (type, i),
705 valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
706 address, stream, recurse + 1, val, &opts,
707 current_language);
708 }
709 }
710 annotate_field_end ();
711 }
712
713 if (dont_print_statmem == 0)
714 {
715 /* Free the space used to deal with the printing
716 of the members from top level. */
717 obstack_free (&dont_print_statmem_obstack, last_dont_print);
718 dont_print_statmem_obstack = tmp_obstack;
719 }
720
721 if (options->pretty)
722 {
723 fprintf_filtered (stream, "\n");
724 print_spaces_filtered (2 * recurse, stream);
725 }
726 }
727 fprintf_filtered (stream, "}");
728 }
729
730 /* Special val_print routine to avoid printing multiple copies of virtual
731 baseclasses. */
732
733 static void
734 pascal_object_print_value (struct type *type, const gdb_byte *valaddr,
735 int offset,
736 CORE_ADDR address, struct ui_file *stream,
737 int recurse,
738 const struct value *val,
739 const struct value_print_options *options,
740 struct type **dont_print_vb)
741 {
742 struct type **last_dont_print
743 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
744 struct obstack tmp_obstack = dont_print_vb_obstack;
745 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
746
747 if (dont_print_vb == 0)
748 {
749 /* If we're at top level, carve out a completely fresh
750 chunk of the obstack and use that until this particular
751 invocation returns. */
752 /* Bump up the high-water mark. Now alpha is omega. */
753 obstack_finish (&dont_print_vb_obstack);
754 }
755
756 for (i = 0; i < n_baseclasses; i++)
757 {
758 int boffset = 0;
759 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
760 const char *basename = type_name_no_tag (baseclass);
761 const gdb_byte *base_valaddr = NULL;
762 int thisoffset;
763 volatile struct gdb_exception ex;
764 int skip = 0;
765
766 if (BASETYPE_VIA_VIRTUAL (type, i))
767 {
768 struct type **first_dont_print
769 = (struct type **) obstack_base (&dont_print_vb_obstack);
770
771 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
772 - first_dont_print;
773
774 while (--j >= 0)
775 if (baseclass == first_dont_print[j])
776 goto flush_it;
777
778 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
779 }
780
781 thisoffset = offset;
782
783 TRY_CATCH (ex, RETURN_MASK_ERROR)
784 {
785 boffset = baseclass_offset (type, i, valaddr, offset, address, val);
786 }
787 if (ex.reason < 0 && ex.error == NOT_AVAILABLE_ERROR)
788 skip = -1;
789 else if (ex.reason < 0)
790 skip = 1;
791 else
792 {
793 skip = 0;
794
795 /* The virtual base class pointer might have been clobbered by the
796 user program. Make sure that it still points to a valid memory
797 location. */
798
799 if (boffset < 0 || boffset >= TYPE_LENGTH (type))
800 {
801 /* FIXME (alloc): not safe is baseclass is really really big. */
802 gdb_byte *buf = alloca (TYPE_LENGTH (baseclass));
803
804 base_valaddr = buf;
805 if (target_read_memory (address + boffset, buf,
806 TYPE_LENGTH (baseclass)) != 0)
807 skip = 1;
808 address = address + boffset;
809 thisoffset = 0;
810 boffset = 0;
811 }
812 else
813 base_valaddr = valaddr;
814 }
815
816 if (options->pretty)
817 {
818 fprintf_filtered (stream, "\n");
819 print_spaces_filtered (2 * recurse, stream);
820 }
821 fputs_filtered ("<", stream);
822 /* Not sure what the best notation is in the case where there is no
823 baseclass name. */
824
825 fputs_filtered (basename ? basename : "", stream);
826 fputs_filtered ("> = ", stream);
827
828 if (skip < 0)
829 val_print_unavailable (stream);
830 else if (skip > 0)
831 val_print_invalid_address (stream);
832 else
833 pascal_object_print_value_fields (baseclass, base_valaddr,
834 thisoffset + boffset, address,
835 stream, recurse, val, options,
836 (struct type **) obstack_base (&dont_print_vb_obstack),
837 0);
838 fputs_filtered (", ", stream);
839
840 flush_it:
841 ;
842 }
843
844 if (dont_print_vb == 0)
845 {
846 /* Free the space used to deal with the printing
847 of this type from top level. */
848 obstack_free (&dont_print_vb_obstack, last_dont_print);
849 /* Reset watermark so that we can continue protecting
850 ourselves from whatever we were protecting ourselves. */
851 dont_print_vb_obstack = tmp_obstack;
852 }
853 }
854
855 /* Print value of a static member.
856 To avoid infinite recursion when printing a class that contains
857 a static instance of the class, we keep the addresses of all printed
858 static member classes in an obstack and refuse to print them more
859 than once.
860
861 VAL contains the value to print, STREAM, RECURSE, and OPTIONS
862 have the same meanings as in c_val_print. */
863
864 static void
865 pascal_object_print_static_field (struct value *val,
866 struct ui_file *stream,
867 int recurse,
868 const struct value_print_options *options)
869 {
870 struct type *type = value_type (val);
871 struct value_print_options opts;
872
873 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
874 {
875 CORE_ADDR *first_dont_print, addr;
876 int i;
877
878 first_dont_print
879 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
880 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
881 - first_dont_print;
882
883 while (--i >= 0)
884 {
885 if (value_address (val) == first_dont_print[i])
886 {
887 fputs_filtered ("\
888 <same as static member of an already seen type>",
889 stream);
890 return;
891 }
892 }
893
894 addr = value_address (val);
895 obstack_grow (&dont_print_statmem_obstack, (char *) &addr,
896 sizeof (CORE_ADDR));
897
898 CHECK_TYPEDEF (type);
899 pascal_object_print_value_fields (type,
900 value_contents_for_printing (val),
901 value_embedded_offset (val),
902 addr,
903 stream, recurse,
904 val, options, NULL, 1);
905 return;
906 }
907
908 opts = *options;
909 opts.deref_ref = 0;
910 common_val_print (val, stream, recurse, &opts, current_language);
911 }
912
913 /* -Wmissing-prototypes */
914 extern initialize_file_ftype _initialize_pascal_valprint;
915
916 void
917 _initialize_pascal_valprint (void)
918 {
919 add_setshow_boolean_cmd ("pascal_static-members", class_support,
920 &user_print_options.pascal_static_field_print, _("\
921 Set printing of pascal static members."), _("\
922 Show printing of pascal static members."), NULL,
923 NULL,
924 show_pascal_static_field_print,
925 &setprintlist, &showprintlist);
926 }
This page took 0.048716 seconds and 4 git commands to generate.