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