]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blob - gdb/p-valprint.c
2004-11-09 Andrew Cagney <cagney@gnu.org>
[thirdparty/binutils-gdb.git] / gdb / p-valprint.c
1 /* Support for printing Pascal values for GDB, the GNU debugger.
2 Copyright 2000, 2001, 2003
3 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 2 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, write to the Free Software
19 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
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 \f
41
42
43
44 /* Print data of type TYPE located at VALADDR (within GDB), which came from
45 the inferior at address ADDRESS, onto stdio stream STREAM according to
46 FORMAT (a letter or 0 for natural format). The data at VALADDR is in
47 target byte order.
48
49 If the data are a string pointer, returns the number of string characters
50 printed.
51
52 If DEREF_REF is nonzero, then dereference references, otherwise just print
53 them like pointers.
54
55 The PRETTY parameter controls prettyprinting. */
56
57
58 int
59 pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
60 CORE_ADDR address, struct ui_file *stream, int format,
61 int deref_ref, int recurse, enum val_prettyprint pretty)
62 {
63 unsigned int i = 0; /* Number of characters printed */
64 unsigned len;
65 struct type *elttype;
66 unsigned eltlen;
67 int length_pos, length_size, string_pos;
68 int char_size;
69 LONGEST val;
70 CORE_ADDR addr;
71
72 CHECK_TYPEDEF (type);
73 switch (TYPE_CODE (type))
74 {
75 case TYPE_CODE_ARRAY:
76 if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
77 {
78 elttype = check_typedef (TYPE_TARGET_TYPE (type));
79 eltlen = TYPE_LENGTH (elttype);
80 len = TYPE_LENGTH (type) / eltlen;
81 if (prettyprint_arrays)
82 {
83 print_spaces_filtered (2 + 2 * recurse, stream);
84 }
85 /* For an array of chars, print with string syntax. */
86 if (eltlen == 1 &&
87 ((TYPE_CODE (elttype) == TYPE_CODE_INT)
88 || ((current_language->la_language == language_m2)
89 && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
90 && (format == 0 || format == 's'))
91 {
92 /* If requested, look for the first null char and only print
93 elements up to it. */
94 if (stop_print_at_null)
95 {
96 unsigned int temp_len;
97
98 /* Look for a NULL char. */
99 for (temp_len = 0;
100 (valaddr + embedded_offset)[temp_len]
101 && temp_len < len && temp_len < print_max;
102 temp_len++);
103 len = temp_len;
104 }
105
106 LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0);
107 i = len;
108 }
109 else
110 {
111 fprintf_filtered (stream, "{");
112 /* If this is a virtual function table, print the 0th
113 entry specially, and the rest of the members normally. */
114 if (pascal_object_is_vtbl_ptr_type (elttype))
115 {
116 i = 1;
117 fprintf_filtered (stream, "%d vtable entries", len - 1);
118 }
119 else
120 {
121 i = 0;
122 }
123 val_print_array_elements (type, valaddr + embedded_offset, address, stream,
124 format, deref_ref, recurse, pretty, i);
125 fprintf_filtered (stream, "}");
126 }
127 break;
128 }
129 /* Array of unspecified length: treat like pointer to first elt. */
130 addr = address;
131 goto print_unpacked_pointer;
132
133 case TYPE_CODE_PTR:
134 if (format && format != 's')
135 {
136 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
137 break;
138 }
139 if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
140 {
141 /* Print the unmangled name if desired. */
142 /* Print vtable entry - we only get here if we ARE using
143 -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
144 /* Extract the address, assume that it is unsigned. */
145 print_address_demangle (extract_unsigned_integer (valaddr + embedded_offset, TYPE_LENGTH (type)),
146 stream, demangle);
147 break;
148 }
149 elttype = check_typedef (TYPE_TARGET_TYPE (type));
150 if (TYPE_CODE (elttype) == TYPE_CODE_METHOD)
151 {
152 pascal_object_print_class_method (valaddr + embedded_offset, type, stream);
153 }
154 else if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
155 {
156 pascal_object_print_class_member (valaddr + embedded_offset,
157 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type)),
158 stream, "&");
159 }
160 else
161 {
162 addr = unpack_pointer (type, valaddr + embedded_offset);
163 print_unpacked_pointer:
164 elttype = check_typedef (TYPE_TARGET_TYPE (type));
165
166 if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
167 {
168 /* Try to print what function it points to. */
169 print_address_demangle (addr, stream, demangle);
170 /* Return value is irrelevant except for string pointers. */
171 return (0);
172 }
173
174 if (addressprint && format != 's')
175 {
176 print_address_numeric (addr, 1, stream);
177 }
178
179 /* For a pointer to char or unsigned char, also print the string
180 pointed to, unless pointer is null. */
181 if (TYPE_LENGTH (elttype) == 1
182 && TYPE_CODE (elttype) == TYPE_CODE_INT
183 && (format == 0 || format == 's')
184 && addr != 0)
185 {
186 /* no wide string yet */
187 i = val_print_string (addr, -1, 1, stream);
188 }
189 /* also for pointers to pascal strings */
190 /* Note: this is Free Pascal specific:
191 as GDB does not recognize stabs pascal strings
192 Pascal strings are mapped to records
193 with lowercase names PM */
194 if (is_pascal_string_type (elttype, &length_pos, &length_size,
195 &string_pos, &char_size, NULL)
196 && addr != 0)
197 {
198 ULONGEST string_length;
199 void *buffer;
200 buffer = xmalloc (length_size);
201 read_memory (addr + length_pos, buffer, length_size);
202 string_length = extract_unsigned_integer (buffer, length_size);
203 xfree (buffer);
204 i = val_print_string (addr + string_pos, string_length, char_size, stream);
205 }
206 else if (pascal_object_is_vtbl_member (type))
207 {
208 /* print vtbl's nicely */
209 CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
210
211 struct minimal_symbol *msymbol =
212 lookup_minimal_symbol_by_pc (vt_address);
213 if ((msymbol != NULL)
214 && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
215 {
216 fputs_filtered (" <", stream);
217 fputs_filtered (SYMBOL_PRINT_NAME (msymbol), stream);
218 fputs_filtered (">", stream);
219 }
220 if (vt_address && vtblprint)
221 {
222 struct value *vt_val;
223 struct symbol *wsym = (struct symbol *) NULL;
224 struct type *wtype;
225 struct block *block = (struct block *) NULL;
226 int is_this_fld;
227
228 if (msymbol != NULL)
229 wsym = lookup_symbol (DEPRECATED_SYMBOL_NAME (msymbol), block,
230 VAR_DOMAIN, &is_this_fld, NULL);
231
232 if (wsym)
233 {
234 wtype = SYMBOL_TYPE (wsym);
235 }
236 else
237 {
238 wtype = TYPE_TARGET_TYPE (type);
239 }
240 vt_val = value_at (wtype, vt_address);
241 val_print (VALUE_TYPE (vt_val), VALUE_CONTENTS (vt_val), 0,
242 VALUE_ADDRESS (vt_val), stream, format,
243 deref_ref, recurse + 1, pretty);
244 if (pretty)
245 {
246 fprintf_filtered (stream, "\n");
247 print_spaces_filtered (2 + 2 * recurse, stream);
248 }
249 }
250 }
251
252 /* Return number of characters printed, including the terminating
253 '\0' if we reached the end. val_print_string takes care including
254 the terminating '\0' if necessary. */
255 return i;
256 }
257 break;
258
259 case TYPE_CODE_MEMBER:
260 error ("not implemented: member type in pascal_val_print");
261 break;
262
263 case TYPE_CODE_REF:
264 elttype = check_typedef (TYPE_TARGET_TYPE (type));
265 if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
266 {
267 pascal_object_print_class_member (valaddr + embedded_offset,
268 TYPE_DOMAIN_TYPE (elttype),
269 stream, "");
270 break;
271 }
272 if (addressprint)
273 {
274 fprintf_filtered (stream, "@");
275 /* Extract the address, assume that it is unsigned. */
276 print_address_numeric
277 (extract_unsigned_integer (valaddr + embedded_offset,
278 TARGET_PTR_BIT / HOST_CHAR_BIT),
279 1, stream);
280 if (deref_ref)
281 fputs_filtered (": ", stream);
282 }
283 /* De-reference the reference. */
284 if (deref_ref)
285 {
286 if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
287 {
288 struct value *deref_val =
289 value_at
290 (TYPE_TARGET_TYPE (type),
291 unpack_pointer (lookup_pointer_type (builtin_type_void),
292 valaddr + embedded_offset));
293 val_print (VALUE_TYPE (deref_val),
294 VALUE_CONTENTS (deref_val), 0,
295 VALUE_ADDRESS (deref_val), stream, format,
296 deref_ref, recurse + 1, pretty);
297 }
298 else
299 fputs_filtered ("???", stream);
300 }
301 break;
302
303 case TYPE_CODE_UNION:
304 if (recurse && !unionprint)
305 {
306 fprintf_filtered (stream, "{...}");
307 break;
308 }
309 /* Fall through. */
310 case TYPE_CODE_STRUCT:
311 if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
312 {
313 /* Print the unmangled name if desired. */
314 /* Print vtable entry - we only get here if NOT using
315 -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
316 /* Extract the address, assume that it is unsigned. */
317 print_address_demangle
318 (extract_unsigned_integer (valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
319 TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET))),
320 stream, demangle);
321 }
322 else
323 {
324 if (is_pascal_string_type (type, &length_pos, &length_size,
325 &string_pos, &char_size, NULL))
326 {
327 len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size);
328 LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0);
329 }
330 else
331 pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream, format,
332 recurse, pretty, NULL, 0);
333 }
334 break;
335
336 case TYPE_CODE_ENUM:
337 if (format)
338 {
339 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
340 break;
341 }
342 len = TYPE_NFIELDS (type);
343 val = unpack_long (type, valaddr + embedded_offset);
344 for (i = 0; i < len; i++)
345 {
346 QUIT;
347 if (val == TYPE_FIELD_BITPOS (type, i))
348 {
349 break;
350 }
351 }
352 if (i < len)
353 {
354 fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
355 }
356 else
357 {
358 print_longest (stream, 'd', 0, val);
359 }
360 break;
361
362 case TYPE_CODE_FUNC:
363 if (format)
364 {
365 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
366 break;
367 }
368 /* FIXME, we should consider, at least for ANSI C language, eliminating
369 the distinction made between FUNCs and POINTERs to FUNCs. */
370 fprintf_filtered (stream, "{");
371 type_print (type, "", stream, -1);
372 fprintf_filtered (stream, "} ");
373 /* Try to print what function it points to, and its address. */
374 print_address_demangle (address, stream, demangle);
375 break;
376
377 case TYPE_CODE_BOOL:
378 format = format ? format : output_format;
379 if (format)
380 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
381 else
382 {
383 val = unpack_long (type, valaddr + embedded_offset);
384 if (val == 0)
385 fputs_filtered ("false", stream);
386 else if (val == 1)
387 fputs_filtered ("true", stream);
388 else
389 {
390 fputs_filtered ("true (", stream);
391 fprintf_filtered (stream, "%ld)", (long int) val);
392 }
393 }
394 break;
395
396 case TYPE_CODE_RANGE:
397 /* FIXME: create_range_type does not set the unsigned bit in a
398 range type (I think it probably should copy it from the target
399 type), so we won't print values which are too large to
400 fit in a signed integer correctly. */
401 /* FIXME: Doesn't handle ranges of enums correctly. (Can't just
402 print with the target type, though, because the size of our type
403 and the target type might differ). */
404 /* FALLTHROUGH */
405
406 case TYPE_CODE_INT:
407 format = format ? format : output_format;
408 if (format)
409 {
410 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
411 }
412 else
413 {
414 val_print_type_code_int (type, valaddr + embedded_offset, stream);
415 }
416 break;
417
418 case TYPE_CODE_CHAR:
419 format = format ? format : output_format;
420 if (format)
421 {
422 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
423 }
424 else
425 {
426 val = unpack_long (type, valaddr + embedded_offset);
427 if (TYPE_UNSIGNED (type))
428 fprintf_filtered (stream, "%u", (unsigned int) val);
429 else
430 fprintf_filtered (stream, "%d", (int) val);
431 fputs_filtered (" ", stream);
432 LA_PRINT_CHAR ((unsigned char) val, stream);
433 }
434 break;
435
436 case TYPE_CODE_FLT:
437 if (format)
438 {
439 print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
440 }
441 else
442 {
443 print_floating (valaddr + embedded_offset, type, stream);
444 }
445 break;
446
447 case TYPE_CODE_BITSTRING:
448 case TYPE_CODE_SET:
449 elttype = TYPE_INDEX_TYPE (type);
450 CHECK_TYPEDEF (elttype);
451 if (TYPE_STUB (elttype))
452 {
453 fprintf_filtered (stream, "<incomplete type>");
454 gdb_flush (stream);
455 break;
456 }
457 else
458 {
459 struct type *range = elttype;
460 LONGEST low_bound, high_bound;
461 int i;
462 int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
463 int need_comma = 0;
464
465 if (is_bitstring)
466 fputs_filtered ("B'", stream);
467 else
468 fputs_filtered ("[", stream);
469
470 i = get_discrete_bounds (range, &low_bound, &high_bound);
471 maybe_bad_bstring:
472 if (i < 0)
473 {
474 fputs_filtered ("<error value>", stream);
475 goto done;
476 }
477
478 for (i = low_bound; i <= high_bound; i++)
479 {
480 int element = value_bit_index (type, valaddr + embedded_offset, i);
481 if (element < 0)
482 {
483 i = element;
484 goto maybe_bad_bstring;
485 }
486 if (is_bitstring)
487 fprintf_filtered (stream, "%d", element);
488 else if (element)
489 {
490 if (need_comma)
491 fputs_filtered (", ", stream);
492 print_type_scalar (range, i, stream);
493 need_comma = 1;
494
495 if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
496 {
497 int j = i;
498 fputs_filtered ("..", stream);
499 while (i + 1 <= high_bound
500 && value_bit_index (type, valaddr + embedded_offset, ++i))
501 j = i;
502 print_type_scalar (range, j, stream);
503 }
504 }
505 }
506 done:
507 if (is_bitstring)
508 fputs_filtered ("'", stream);
509 else
510 fputs_filtered ("]", stream);
511 }
512 break;
513
514 case TYPE_CODE_VOID:
515 fprintf_filtered (stream, "void");
516 break;
517
518 case TYPE_CODE_ERROR:
519 fprintf_filtered (stream, "<error type>");
520 break;
521
522 case TYPE_CODE_UNDEF:
523 /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
524 dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
525 and no complete type for struct foo in that file. */
526 fprintf_filtered (stream, "<incomplete type>");
527 break;
528
529 default:
530 error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type));
531 }
532 gdb_flush (stream);
533 return (0);
534 }
535 \f
536 int
537 pascal_value_print (struct value *val, struct ui_file *stream, int format,
538 enum val_prettyprint pretty)
539 {
540 struct type *type = VALUE_TYPE (val);
541
542 /* If it is a pointer, indicate what it points to.
543
544 Print type also if it is a reference.
545
546 Object pascal: if it is a member pointer, we will take care
547 of that when we print it. */
548 if (TYPE_CODE (type) == TYPE_CODE_PTR ||
549 TYPE_CODE (type) == TYPE_CODE_REF)
550 {
551 /* Hack: remove (char *) for char strings. Their
552 type is indicated by the quoted string anyway. */
553 if (TYPE_CODE (type) == TYPE_CODE_PTR &&
554 TYPE_NAME (type) == NULL &&
555 TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL
556 && strcmp (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char") == 0)
557 {
558 /* Print nothing */
559 }
560 else
561 {
562 fprintf_filtered (stream, "(");
563 type_print (type, "", stream, -1);
564 fprintf_filtered (stream, ") ");
565 }
566 }
567 return val_print (type, VALUE_CONTENTS (val), VALUE_EMBEDDED_OFFSET (val),
568 VALUE_ADDRESS (val) + VALUE_OFFSET (val),
569 stream, format, 1, 0, pretty);
570 }
571
572
573 /******************************************************************************
574 Inserted from cp-valprint
575 ******************************************************************************/
576
577 extern int vtblprint; /* Controls printing of vtbl's */
578 extern int objectprint; /* Controls looking up an object's derived type
579 using what we find in its vtables. */
580 static int pascal_static_field_print; /* Controls printing of static fields. */
581
582 static struct obstack dont_print_vb_obstack;
583 static struct obstack dont_print_statmem_obstack;
584
585 static void pascal_object_print_static_field (struct type *, struct value *,
586 struct ui_file *, int, int,
587 enum val_prettyprint);
588
589 static void
590 pascal_object_print_value (struct type *, char *, CORE_ADDR, struct ui_file *,
591 int, int, enum val_prettyprint, struct type **);
592
593 void
594 pascal_object_print_class_method (char *valaddr, struct type *type,
595 struct ui_file *stream)
596 {
597 struct type *domain;
598 struct fn_field *f = NULL;
599 int j = 0;
600 int len2;
601 int offset;
602 char *kind = "";
603 CORE_ADDR addr;
604 struct symbol *sym;
605 unsigned len;
606 unsigned int i;
607 struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
608
609 domain = TYPE_DOMAIN_TYPE (target_type);
610 if (domain == (struct type *) NULL)
611 {
612 fprintf_filtered (stream, "<unknown>");
613 return;
614 }
615 addr = unpack_pointer (lookup_pointer_type (builtin_type_void), valaddr);
616 if (METHOD_PTR_IS_VIRTUAL (addr))
617 {
618 offset = METHOD_PTR_TO_VOFFSET (addr);
619 len = TYPE_NFN_FIELDS (domain);
620 for (i = 0; i < len; i++)
621 {
622 f = TYPE_FN_FIELDLIST1 (domain, i);
623 len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
624
625 check_stub_method_group (domain, i);
626 for (j = 0; j < len2; j++)
627 {
628 if (TYPE_FN_FIELD_VOFFSET (f, j) == offset)
629 {
630 kind = "virtual ";
631 goto common;
632 }
633 }
634 }
635 }
636 else
637 {
638 sym = find_pc_function (addr);
639 if (sym == 0)
640 {
641 error ("invalid pointer to member function");
642 }
643 len = TYPE_NFN_FIELDS (domain);
644 for (i = 0; i < len; i++)
645 {
646 f = TYPE_FN_FIELDLIST1 (domain, i);
647 len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
648
649 check_stub_method_group (domain, i);
650 for (j = 0; j < len2; j++)
651 {
652 if (DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (sym), TYPE_FN_FIELD_PHYSNAME (f, j)))
653 goto common;
654 }
655 }
656 }
657 common:
658 if (i < len)
659 {
660 char *demangled_name;
661
662 fprintf_filtered (stream, "&");
663 fputs_filtered (kind, stream);
664 demangled_name = cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f, j),
665 DMGL_ANSI | DMGL_PARAMS);
666 if (demangled_name == NULL)
667 fprintf_filtered (stream, "<badly mangled name %s>",
668 TYPE_FN_FIELD_PHYSNAME (f, j));
669 else
670 {
671 fputs_filtered (demangled_name, stream);
672 xfree (demangled_name);
673 }
674 }
675 else
676 {
677 fprintf_filtered (stream, "(");
678 type_print (type, "", stream, -1);
679 fprintf_filtered (stream, ") %d", (int) addr >> 3);
680 }
681 }
682
683 /* It was changed to this after 2.4.5. */
684 const char pascal_vtbl_ptr_name[] =
685 {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
686
687 /* Return truth value for assertion that TYPE is of the type
688 "pointer to virtual function". */
689
690 int
691 pascal_object_is_vtbl_ptr_type (struct type *type)
692 {
693 char *typename = type_name_no_tag (type);
694
695 return (typename != NULL
696 && strcmp (typename, pascal_vtbl_ptr_name) == 0);
697 }
698
699 /* Return truth value for the assertion that TYPE is of the type
700 "pointer to virtual function table". */
701
702 int
703 pascal_object_is_vtbl_member (struct type *type)
704 {
705 if (TYPE_CODE (type) == TYPE_CODE_PTR)
706 {
707 type = TYPE_TARGET_TYPE (type);
708 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
709 {
710 type = TYPE_TARGET_TYPE (type);
711 if (TYPE_CODE (type) == TYPE_CODE_STRUCT /* if not using thunks */
712 || TYPE_CODE (type) == TYPE_CODE_PTR) /* if using thunks */
713 {
714 /* Virtual functions tables are full of pointers
715 to virtual functions. */
716 return pascal_object_is_vtbl_ptr_type (type);
717 }
718 }
719 }
720 return 0;
721 }
722
723 /* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
724 print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
725
726 TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
727 same meanings as in pascal_object_print_value and c_val_print.
728
729 DONT_PRINT is an array of baseclass types that we
730 should not print, or zero if called from top level. */
731
732 void
733 pascal_object_print_value_fields (struct type *type, char *valaddr,
734 CORE_ADDR address, struct ui_file *stream,
735 int format, int recurse,
736 enum val_prettyprint pretty,
737 struct type **dont_print_vb,
738 int dont_print_statmem)
739 {
740 int i, len, n_baseclasses;
741 struct obstack tmp_obstack;
742 char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
743
744 CHECK_TYPEDEF (type);
745
746 fprintf_filtered (stream, "{");
747 len = TYPE_NFIELDS (type);
748 n_baseclasses = TYPE_N_BASECLASSES (type);
749
750 /* Print out baseclasses such that we don't print
751 duplicates of virtual baseclasses. */
752 if (n_baseclasses > 0)
753 pascal_object_print_value (type, valaddr, address, stream,
754 format, recurse + 1, pretty, dont_print_vb);
755
756 if (!len && n_baseclasses == 1)
757 fprintf_filtered (stream, "<No data fields>");
758 else
759 {
760 int fields_seen = 0;
761
762 if (dont_print_statmem == 0)
763 {
764 /* If we're at top level, carve out a completely fresh
765 chunk of the obstack and use that until this particular
766 invocation returns. */
767 tmp_obstack = dont_print_statmem_obstack;
768 obstack_finish (&dont_print_statmem_obstack);
769 }
770
771 for (i = n_baseclasses; i < len; i++)
772 {
773 /* If requested, skip printing of static fields. */
774 if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i))
775 continue;
776 if (fields_seen)
777 fprintf_filtered (stream, ", ");
778 else if (n_baseclasses > 0)
779 {
780 if (pretty)
781 {
782 fprintf_filtered (stream, "\n");
783 print_spaces_filtered (2 + 2 * recurse, stream);
784 fputs_filtered ("members of ", stream);
785 fputs_filtered (type_name_no_tag (type), stream);
786 fputs_filtered (": ", stream);
787 }
788 }
789 fields_seen = 1;
790
791 if (pretty)
792 {
793 fprintf_filtered (stream, "\n");
794 print_spaces_filtered (2 + 2 * recurse, stream);
795 }
796 else
797 {
798 wrap_here (n_spaces (2 + 2 * recurse));
799 }
800 if (inspect_it)
801 {
802 if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
803 fputs_filtered ("\"( ptr \"", stream);
804 else
805 fputs_filtered ("\"( nodef \"", stream);
806 if (TYPE_FIELD_STATIC (type, i))
807 fputs_filtered ("static ", stream);
808 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
809 language_cplus,
810 DMGL_PARAMS | DMGL_ANSI);
811 fputs_filtered ("\" \"", stream);
812 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
813 language_cplus,
814 DMGL_PARAMS | DMGL_ANSI);
815 fputs_filtered ("\") \"", stream);
816 }
817 else
818 {
819 annotate_field_begin (TYPE_FIELD_TYPE (type, i));
820
821 if (TYPE_FIELD_STATIC (type, i))
822 fputs_filtered ("static ", stream);
823 fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
824 language_cplus,
825 DMGL_PARAMS | DMGL_ANSI);
826 annotate_field_name_end ();
827 fputs_filtered (" = ", stream);
828 annotate_field_value ();
829 }
830
831 if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i))
832 {
833 struct value *v;
834
835 /* Bitfields require special handling, especially due to byte
836 order problems. */
837 if (TYPE_FIELD_IGNORE (type, i))
838 {
839 fputs_filtered ("<optimized out or zero length>", stream);
840 }
841 else
842 {
843 v = value_from_longest (TYPE_FIELD_TYPE (type, i),
844 unpack_field_as_long (type, valaddr, i));
845
846 val_print (TYPE_FIELD_TYPE (type, i), VALUE_CONTENTS (v), 0, 0,
847 stream, format, 0, recurse + 1, pretty);
848 }
849 }
850 else
851 {
852 if (TYPE_FIELD_IGNORE (type, i))
853 {
854 fputs_filtered ("<optimized out or zero length>", stream);
855 }
856 else if (TYPE_FIELD_STATIC (type, i))
857 {
858 /* struct value *v = value_static_field (type, i); v4.17 specific */
859 struct value *v;
860 v = value_from_longest (TYPE_FIELD_TYPE (type, i),
861 unpack_field_as_long (type, valaddr, i));
862
863 if (v == NULL)
864 fputs_filtered ("<optimized out>", stream);
865 else
866 pascal_object_print_static_field (TYPE_FIELD_TYPE (type, i), v,
867 stream, format, recurse + 1,
868 pretty);
869 }
870 else
871 {
872 /* val_print (TYPE_FIELD_TYPE (type, i),
873 valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
874 address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
875 stream, format, 0, recurse + 1, pretty); */
876 val_print (TYPE_FIELD_TYPE (type, i),
877 valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
878 address + TYPE_FIELD_BITPOS (type, i) / 8,
879 stream, format, 0, recurse + 1, pretty);
880 }
881 }
882 annotate_field_end ();
883 }
884
885 if (dont_print_statmem == 0)
886 {
887 /* Free the space used to deal with the printing
888 of the members from top level. */
889 obstack_free (&dont_print_statmem_obstack, last_dont_print);
890 dont_print_statmem_obstack = tmp_obstack;
891 }
892
893 if (pretty)
894 {
895 fprintf_filtered (stream, "\n");
896 print_spaces_filtered (2 * recurse, stream);
897 }
898 }
899 fprintf_filtered (stream, "}");
900 }
901
902 /* Special val_print routine to avoid printing multiple copies of virtual
903 baseclasses. */
904
905 void
906 pascal_object_print_value (struct type *type, char *valaddr, CORE_ADDR address,
907 struct ui_file *stream, int format, int recurse,
908 enum val_prettyprint pretty,
909 struct type **dont_print_vb)
910 {
911 struct obstack tmp_obstack;
912 struct type **last_dont_print
913 = (struct type **) obstack_next_free (&dont_print_vb_obstack);
914 int i, n_baseclasses = TYPE_N_BASECLASSES (type);
915
916 if (dont_print_vb == 0)
917 {
918 /* If we're at top level, carve out a completely fresh
919 chunk of the obstack and use that until this particular
920 invocation returns. */
921 tmp_obstack = dont_print_vb_obstack;
922 /* Bump up the high-water mark. Now alpha is omega. */
923 obstack_finish (&dont_print_vb_obstack);
924 }
925
926 for (i = 0; i < n_baseclasses; i++)
927 {
928 int boffset;
929 struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
930 char *basename = TYPE_NAME (baseclass);
931 char *base_valaddr;
932
933 if (BASETYPE_VIA_VIRTUAL (type, i))
934 {
935 struct type **first_dont_print
936 = (struct type **) obstack_base (&dont_print_vb_obstack);
937
938 int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
939 - first_dont_print;
940
941 while (--j >= 0)
942 if (baseclass == first_dont_print[j])
943 goto flush_it;
944
945 obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
946 }
947
948 boffset = baseclass_offset (type, i, valaddr, address);
949
950 if (pretty)
951 {
952 fprintf_filtered (stream, "\n");
953 print_spaces_filtered (2 * recurse, stream);
954 }
955 fputs_filtered ("<", stream);
956 /* Not sure what the best notation is in the case where there is no
957 baseclass name. */
958
959 fputs_filtered (basename ? basename : "", stream);
960 fputs_filtered ("> = ", stream);
961
962 /* The virtual base class pointer might have been clobbered by the
963 user program. Make sure that it still points to a valid memory
964 location. */
965
966 if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
967 {
968 /* FIXME (alloc): not safe is baseclass is really really big. */
969 base_valaddr = (char *) alloca (TYPE_LENGTH (baseclass));
970 if (target_read_memory (address + boffset, base_valaddr,
971 TYPE_LENGTH (baseclass)) != 0)
972 boffset = -1;
973 }
974 else
975 base_valaddr = valaddr + boffset;
976
977 if (boffset == -1)
978 fprintf_filtered (stream, "<invalid address>");
979 else
980 pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
981 stream, format, recurse, pretty,
982 (struct type **) obstack_base (&dont_print_vb_obstack),
983 0);
984 fputs_filtered (", ", stream);
985
986 flush_it:
987 ;
988 }
989
990 if (dont_print_vb == 0)
991 {
992 /* Free the space used to deal with the printing
993 of this type from top level. */
994 obstack_free (&dont_print_vb_obstack, last_dont_print);
995 /* Reset watermark so that we can continue protecting
996 ourselves from whatever we were protecting ourselves. */
997 dont_print_vb_obstack = tmp_obstack;
998 }
999 }
1000
1001 /* Print value of a static member.
1002 To avoid infinite recursion when printing a class that contains
1003 a static instance of the class, we keep the addresses of all printed
1004 static member classes in an obstack and refuse to print them more
1005 than once.
1006
1007 VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1008 have the same meanings as in c_val_print. */
1009
1010 static void
1011 pascal_object_print_static_field (struct type *type, struct value *val,
1012 struct ui_file *stream, int format,
1013 int recurse, enum val_prettyprint pretty)
1014 {
1015 if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1016 {
1017 CORE_ADDR *first_dont_print;
1018 int i;
1019
1020 first_dont_print
1021 = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1022 i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1023 - first_dont_print;
1024
1025 while (--i >= 0)
1026 {
1027 if (VALUE_ADDRESS (val) == first_dont_print[i])
1028 {
1029 fputs_filtered ("<same as static member of an already seen type>",
1030 stream);
1031 return;
1032 }
1033 }
1034
1035 obstack_grow (&dont_print_statmem_obstack, (char *) &VALUE_ADDRESS (val),
1036 sizeof (CORE_ADDR));
1037
1038 CHECK_TYPEDEF (type);
1039 pascal_object_print_value_fields (type, VALUE_CONTENTS (val), VALUE_ADDRESS (val),
1040 stream, format, recurse, pretty, NULL, 1);
1041 return;
1042 }
1043 val_print (type, VALUE_CONTENTS (val), 0, VALUE_ADDRESS (val),
1044 stream, format, 0, recurse, pretty);
1045 }
1046
1047 void
1048 pascal_object_print_class_member (char *valaddr, struct type *domain,
1049 struct ui_file *stream, char *prefix)
1050 {
1051
1052 /* VAL is a byte offset into the structure type DOMAIN.
1053 Find the name of the field for that offset and
1054 print it. */
1055 int extra = 0;
1056 int bits = 0;
1057 unsigned int i;
1058 unsigned len = TYPE_NFIELDS (domain);
1059 /* @@ Make VAL into bit offset */
1060 LONGEST val = unpack_long (builtin_type_int, valaddr) << 3;
1061 for (i = TYPE_N_BASECLASSES (domain); i < len; i++)
1062 {
1063 int bitpos = TYPE_FIELD_BITPOS (domain, i);
1064 QUIT;
1065 if (val == bitpos)
1066 break;
1067 if (val < bitpos && i != 0)
1068 {
1069 /* Somehow pointing into a field. */
1070 i -= 1;
1071 extra = (val - TYPE_FIELD_BITPOS (domain, i));
1072 if (extra & 0x7)
1073 bits = 1;
1074 else
1075 extra >>= 3;
1076 break;
1077 }
1078 }
1079 if (i < len)
1080 {
1081 char *name;
1082 fputs_filtered (prefix, stream);
1083 name = type_name_no_tag (domain);
1084 if (name)
1085 fputs_filtered (name, stream);
1086 else
1087 pascal_type_print_base (domain, stream, 0, 0);
1088 fprintf_filtered (stream, "::");
1089 fputs_filtered (TYPE_FIELD_NAME (domain, i), stream);
1090 if (extra)
1091 fprintf_filtered (stream, " + %d bytes", extra);
1092 if (bits)
1093 fprintf_filtered (stream, " (offset in bits)");
1094 }
1095 else
1096 fprintf_filtered (stream, "%ld", (long int) (val >> 3));
1097 }
1098
1099 extern initialize_file_ftype _initialize_pascal_valprint; /* -Wmissing-prototypes */
1100
1101 void
1102 _initialize_pascal_valprint (void)
1103 {
1104 deprecated_add_show_from_set
1105 (add_set_cmd ("pascal_static-members", class_support, var_boolean,
1106 (char *) &pascal_static_field_print,
1107 "Set printing of pascal static members.",
1108 &setprintlist),
1109 &showprintlist);
1110 /* Turn on printing of static fields. */
1111 pascal_static_field_print = 1;
1112
1113 }