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