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