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