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