GDB (xrefs)
Loading...
Searching...
No Matches
scm-pretty-print.c
Go to the documentation of this file.
1/* GDB/Scheme pretty-printing.
2
3 Copyright (C) 2008-2023 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/* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
22
23#include "defs.h"
24#include "charset.h"
25#include "symtab.h" /* Needed by language.h. */
26#include "language.h"
27#include "objfiles.h"
28#include "value.h"
29#include "valprint.h"
30#include "guile-internal.h"
31
32/* Return type of print_string_repr. */
33
35{
36 /* The string method returned None. */
38 /* The string method had an error. */
40 /* Everything ok. */
42};
43
44/* Display hints. */
45
47{
48 /* No display hint. */
50 /* The display hint has a bad value. */
52 /* Print as an array. */
54 /* Print as a map. */
56 /* Print as a string. */
58};
59
60/* The <gdb:pretty-printer> smob. */
61
63{
64 /* This must appear first. */
66
67 /* A string representing the name of the printer. */
68 SCM name;
69
70 /* A boolean indicating whether the printer is enabled. */
72
73 /* A procedure called to look up the printer for the given value.
74 The procedure is called as (lookup gdb:pretty-printer value).
75 The result should either be a gdb:pretty-printer object that will print
76 the value, or #f if the value is not recognized. */
77 SCM lookup;
78
79 /* Note: Attaching subprinters to this smob is left to Scheme. */
80};
81
82/* The <gdb:pretty-printer-worker> smob. */
83
85{
86 /* This must appear first. */
88
89 /* Either #f or one of the supported display hints: map, array, string.
90 If neither of those then the display hint is ignored (treated as #f). */
92
93 /* A procedure called to pretty-print the value.
94 (lambda (printer) ...) -> string | <gdb:lazy-string> | <gdb:value> */
96
97 /* A procedure called to print children of the value.
98 (lambda (printer) ...) -> <gdb:iterator>
99 The iterator returns a pair for each iteration: (name . value),
100 where "value" can have the same types as to_string. */
102};
103
104static const char pretty_printer_smob_name[] =
105 "gdb:pretty-printer";
107 "gdb:pretty-printer-worker";
108
109/* The tag Guile knows the pretty-printer smobs by. */
110static scm_t_bits pretty_printer_smob_tag;
112
113/* The global pretty-printer list. */
115
116/* gdb:pp-type-error. */
118
119/* Pretty-printer display hints are specified by strings. */
123
124/* Administrivia for pretty-printer matcher smobs. */
125
126/* The smob "print" function for <gdb:pretty-printer>. */
127
128static int
129ppscm_print_pretty_printer_smob (SCM self, SCM port, scm_print_state *pstate)
130{
131 pretty_printer_smob *pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (self);
132
134 scm_write (pp_smob->name, port);
135 scm_puts (gdbscm_is_true (pp_smob->enabled) ? " enabled" : " disabled",
136 port);
137 scm_puts (">", port);
138
139 scm_remember_upto_here_1 (self);
140
141 /* Non-zero means success. */
142 return 1;
143}
144
145/* (make-pretty-printer string procedure) -> <gdb:pretty-printer> */
146
147static SCM
149{
151 scm_gc_malloc (sizeof (pretty_printer_smob),
153 SCM smob;
154
155 SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, FUNC_NAME,
156 _("string"));
157 SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup), lookup, SCM_ARG2, FUNC_NAME,
158 _("procedure"));
159
160 pp_smob->name = name;
161 pp_smob->lookup = lookup;
162 pp_smob->enabled = SCM_BOOL_T;
163 smob = scm_new_smob (pretty_printer_smob_tag, (scm_t_bits) pp_smob);
164 gdbscm_init_gsmob (&pp_smob->base);
165
166 return smob;
167}
168
169/* Return non-zero if SCM is a <gdb:pretty-printer> object. */
170
171static int
173{
174 return SCM_SMOB_PREDICATE (pretty_printer_smob_tag, scm);
175}
176
177/* (pretty-printer? object) -> boolean */
178
179static SCM
181{
182 return scm_from_bool (ppscm_is_pretty_printer (scm));
183}
184
185/* Returns the <gdb:pretty-printer> object in SELF.
186 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
187
188static SCM
190 const char *func_name)
191{
192 SCM_ASSERT_TYPE (ppscm_is_pretty_printer (self), self, arg_pos, func_name,
194
195 return self;
196}
197
198/* Returns a pointer to the pretty-printer smob of SELF.
199 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
200
201static pretty_printer_smob *
203 const char *func_name)
204{
205 SCM pp_scm = ppscm_get_pretty_printer_arg_unsafe (self, arg_pos, func_name);
206 pretty_printer_smob *pp_smob
207 = (pretty_printer_smob *) SCM_SMOB_DATA (pp_scm);
208
209 return pp_smob;
210}
211
212/* Pretty-printer methods. */
213
214/* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
215
216static SCM
218{
219 pretty_printer_smob *pp_smob
221
222 return pp_smob->enabled;
223}
224
225/* (set-pretty-printer-enabled! <gdb:pretty-printer> boolean)
226 -> unspecified */
227
228static SCM
230{
231 pretty_printer_smob *pp_smob
233
234 pp_smob->enabled = scm_from_bool (gdbscm_is_true (enabled));
235
236 return SCM_UNSPECIFIED;
237}
238
239/* (pretty-printers) -> list
240 Returns the list of global pretty-printers. */
241
242static SCM
244{
245 return pretty_printer_list;
246}
247
248/* (set-pretty-printers! list) -> unspecified
249 Set the global pretty-printers list. */
250
251static SCM
253{
254 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
255 SCM_ARG1, FUNC_NAME, _("list"));
256
257 pretty_printer_list = printers;
258
259 return SCM_UNSPECIFIED;
260}
261
262/* Administrivia for pretty-printer-worker smobs.
263 These are created when a matcher recognizes a value. */
264
265/* The smob "print" function for <gdb:pretty-printer-worker>. */
266
267static int
269 scm_print_state *pstate)
270{
272 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (self);
273
275 scm_write (w_smob->display_hint, port);
276 scm_puts (" ", port);
277 scm_write (w_smob->to_string, port);
278 scm_puts (" ", port);
279 scm_write (w_smob->children, port);
280 scm_puts (">", port);
281
282 scm_remember_upto_here_1 (self);
283
284 /* Non-zero means success. */
285 return 1;
286}
287
288/* (make-pretty-printer-worker string procedure procedure)
289 -> <gdb:pretty-printer-worker> */
290
291static SCM
293 SCM children)
294{
296 scm_gc_malloc (sizeof (pretty_printer_worker_smob),
298 SCM w_scm;
299
300 w_smob->display_hint = display_hint;
301 w_smob->to_string = to_string;
302 w_smob->children = children;
303 w_scm = scm_new_smob (pretty_printer_worker_smob_tag, (scm_t_bits) w_smob);
304 gdbscm_init_gsmob (&w_smob->base);
305 return w_scm;
306}
307
308/* Return non-zero if SCM is a <gdb:pretty-printer-worker> object. */
309
310static int
312{
313 return SCM_SMOB_PREDICATE (pretty_printer_worker_smob_tag, scm);
314}
315
316/* (pretty-printer-worker? object) -> boolean */
317
318static SCM
320{
321 return scm_from_bool (ppscm_is_pretty_printer_worker (scm));
322}
323
324/* Helper function to create a <gdb:exception> object indicating that the
325 type of some value returned from a pretty-printer is invalid. */
326
327static SCM
328ppscm_make_pp_type_error_exception (const char *message, SCM object)
329{
330 std::string msg = string_printf ("%s: ~S", message);
332 NULL /* func */, msg.c_str (),
333 scm_list_1 (object), scm_list_1 (object));
334}
335
336/* Print MESSAGE as an exception (meaning it is controlled by
337 "guile print-stack").
338 Called from the printer code when the Scheme code returns an invalid type
339 for something. */
340
341static void
342ppscm_print_pp_type_error (const char *message, SCM object)
343{
344 SCM exception = ppscm_make_pp_type_error_exception (message, object);
345
346 gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
347}
348
349/* Helper function for find_pretty_printer which iterates over a list,
350 calls each function and inspects output. This will return a
351 <gdb:pretty-printer> object if one recognizes VALUE. If no printer is
352 found, it will return #f. On error, it will return a <gdb:exception>
353 object.
354
355 Note: This has to be efficient and careful.
356 We don't want to excessively slow down printing of values, but any kind of
357 random crud can appear in the pretty-printer list, and we can't crash
358 because of it. */
359
360static SCM
362{
363 SCM orig_list = list;
364
365 if (scm_is_null (list))
366 return SCM_BOOL_F;
367 if (gdbscm_is_false (scm_list_p (list))) /* scm_is_pair? */
368 {
370 (_("pretty-printer list is not a list"), list);
371 }
372
373 for ( ; scm_is_pair (list); list = scm_cdr (list))
374 {
375 SCM matcher = scm_car (list);
376 SCM worker;
377 pretty_printer_smob *pp_smob;
378
379 if (!ppscm_is_pretty_printer (matcher))
380 {
382 (_("pretty-printer list contains non-pretty-printer object"),
383 matcher);
384 }
385
386 pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (matcher);
387
388 /* Skip if disabled. */
389 if (gdbscm_is_false (pp_smob->enabled))
390 continue;
391
392 if (!gdbscm_is_procedure (pp_smob->lookup))
393 {
395 (_("invalid lookup object in pretty-printer matcher"),
396 pp_smob->lookup);
397 }
398
399 worker = gdbscm_safe_call_2 (pp_smob->lookup, matcher,
401 if (!gdbscm_is_false (worker))
402 {
403 if (gdbscm_is_exception (worker))
404 return worker;
406 return worker;
408 (_("invalid result from pretty-printer lookup"), worker);
409 }
410 }
411
412 if (!scm_is_null (list))
413 {
415 (_("pretty-printer list is not a list"), orig_list);
416 }
417
418 return SCM_BOOL_F;
419}
420
421/* Subroutine of find_pretty_printer to simplify it.
422 Look for a pretty-printer to print VALUE in all objfiles.
423 If there's an error an exception smob is returned.
424 The result is #f, if no pretty-printer was found.
425 Otherwise the result is the pretty-printer smob. */
426
427static SCM
429{
431 {
433 SCM pp
435 value);
436
437 /* Note: This will return if pp is a <gdb:exception> object,
438 which is what we want. */
439 if (gdbscm_is_true (pp))
440 return pp;
441 }
442
443 return SCM_BOOL_F;
444}
445
446/* Subroutine of find_pretty_printer to simplify it.
447 Look for a pretty-printer to print VALUE in the current program space.
448 If there's an error an exception smob is returned.
449 The result is #f, if no pretty-printer was found.
450 Otherwise the result is the pretty-printer smob. */
451
452static SCM
454{
456 SCM pp
458
459 return pp;
460}
461
462/* Subroutine of find_pretty_printer to simplify it.
463 Look for a pretty-printer to print VALUE in the gdb module.
464 If there's an error a Scheme exception is returned.
465 The result is #f, if no pretty-printer was found.
466 Otherwise the result is the pretty-printer smob. */
467
468static SCM
470{
472
473 return pp;
474}
475
476/* Find the pretty-printing constructor function for VALUE. If no
477 pretty-printer exists, return #f. If one exists, return the
478 gdb:pretty-printer smob that implements it. On error, an exception smob
479 is returned.
480
481 Note: In the end it may be better to call out to Scheme once, and then
482 do all of the lookup from Scheme. TBD. */
483
484static SCM
486{
487 SCM pp;
488
489 /* Look at the pretty-printer list for each objfile
490 in the current program-space. */
492 /* Note: This will return if function is a <gdb:exception> object,
493 which is what we want. */
494 if (gdbscm_is_true (pp))
495 return pp;
496
497 /* Look at the pretty-printer list for the current program-space. */
499 /* Note: This will return if function is a <gdb:exception> object,
500 which is what we want. */
501 if (gdbscm_is_true (pp))
502 return pp;
503
504 /* Look at the pretty-printer list in the gdb module. */
506 return pp;
507}
508
509/* Pretty-print a single value, via the PRINTER, which must be a
510 <gdb:pretty-printer-worker> object.
511 The caller is responsible for ensuring PRINTER is valid.
512 If the function returns a string, an SCM containing the string
513 is returned. If the function returns #f that means the pretty
514 printer returned #f as a value. Otherwise, if the function returns a
515 <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
516 It is an error if the printer returns #t.
517 On error, an exception smob is returned. */
518
519static SCM
520ppscm_pretty_print_one_value (SCM printer, struct value **out_value,
521 struct gdbarch *gdbarch,
522 const struct language_defn *language)
523{
524 SCM result = SCM_BOOL_F;
525
526 *out_value = NULL;
527 try
528 {
530 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
531
532 result = gdbscm_safe_call_1 (w_smob->to_string, printer,
534 if (gdbscm_is_false (result))
535 ; /* Done. */
536 else if (scm_is_string (result)
537 || lsscm_is_lazy_string (result))
538 ; /* Done. */
539 else if (vlscm_is_value (result))
540 {
541 SCM except_scm;
542
543 *out_value
545 result, &except_scm,
547 if (*out_value != NULL)
548 result = SCM_BOOL_T;
549 else
550 result = except_scm;
551 }
552 else if (gdbscm_is_exception (result))
553 ; /* Done. */
554 else
555 {
556 /* Invalid result from to-string. */
558 (_("invalid result from pretty-printer to-string"), result);
559 }
560 }
561 catch (const gdb_exception &except)
562 {
563 }
564
565 return result;
566}
567
568/* Return the display hint for PRINTER as a Scheme object.
569 The caller is responsible for ensuring PRINTER is a
570 <gdb:pretty-printer-worker> object. */
571
572static SCM
574{
576 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
577
578 return w_smob->display_hint;
579}
580
581/* Return the display hint for the pretty-printer PRINTER.
582 The caller is responsible for ensuring PRINTER is a
583 <gdb:pretty-printer-worker> object.
584 Returns the display hint or #f if the hint is not a string. */
585
586static enum display_hint
588{
589 SCM hint = ppscm_get_display_hint_scm (printer);
590
591 if (gdbscm_is_false (hint))
592 return HINT_NONE;
593 if (scm_is_string (hint))
594 {
595 if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_array_string)))
596 return HINT_STRING;
597 if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_map_string)))
598 return HINT_STRING;
599 if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_string_string)))
600 return HINT_STRING;
601 return HINT_ERROR;
602 }
603 return HINT_ERROR;
604}
605
606/* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
607 EXCEPTION is a <gdb:exception> object. */
608
609static void
611 struct ui_file *stream)
612{
614 {
615 gdb::unique_xmalloc_ptr<char> msg
617
618 /* This "shouldn't happen", but play it safe. */
619 if (msg == NULL || msg.get ()[0] == '\0')
620 gdb_printf (stream, _("<error reading variable>"));
621 else
622 {
623 /* Remove the trailing newline. We could instead call a special
624 routine for printing memory error messages, but this is easy
625 enough for now. */
626 char *msg_text = msg.get ();
627 size_t len = strlen (msg_text);
628
629 if (msg_text[len - 1] == '\n')
630 msg_text[len - 1] = '\0';
631 gdb_printf (stream, _("<error reading variable: %s>"), msg_text);
632 }
633 }
634 else
635 gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
636}
637
638/* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
639 formats the result. */
640
641static enum guile_string_repr_result
642ppscm_print_string_repr (SCM printer, enum display_hint hint,
643 struct ui_file *stream, int recurse,
644 const struct value_print_options *options,
645 struct gdbarch *gdbarch,
646 const struct language_defn *language)
647{
648 struct value *replacement = NULL;
649 SCM str_scm;
651
652 str_scm = ppscm_pretty_print_one_value (printer, &replacement,
654 if (gdbscm_is_false (str_scm))
655 {
656 result = STRING_REPR_NONE;
657 }
658 else if (scm_is_eq (str_scm, SCM_BOOL_T))
659 {
660 struct value_print_options opts = *options;
661
662 gdb_assert (replacement != NULL);
663 opts.addressprint = 0;
664 common_val_print (replacement, stream, recurse, &opts, language);
665 result = STRING_REPR_OK;
666 }
667 else if (scm_is_string (str_scm))
668 {
669 size_t length;
670 gdb::unique_xmalloc_ptr<char> string
671 = gdbscm_scm_to_string (str_scm, &length,
672 target_charset (gdbarch), 0 , NULL);
673
674 if (hint == HINT_STRING)
675 {
677
678 language->printstr (stream, type, (gdb_byte *) string.get (),
679 length, NULL, 0, options);
680 }
681 else
682 {
683 /* Alas scm_to_stringn doesn't nul-terminate the string if we
684 ask for the length. */
685 size_t i;
686
687 for (i = 0; i < length; ++i)
688 {
689 if (string.get ()[i] == '\0')
690 gdb_puts ("\\000", stream);
691 else
692 gdb_putc (string.get ()[i], stream);
693 }
694 }
695 result = STRING_REPR_OK;
696 }
697 else if (lsscm_is_lazy_string (str_scm))
698 {
699 struct value_print_options local_opts = *options;
700
701 local_opts.addressprint = 0;
702 lsscm_val_print_lazy_string (str_scm, stream, &local_opts);
703 result = STRING_REPR_OK;
704 }
705 else
706 {
707 gdb_assert (gdbscm_is_exception (str_scm));
709 result = STRING_REPR_ERROR;
710 }
711
712 return result;
713}
714
715/* Helper for gdbscm_apply_val_pretty_printer that formats children of the
716 printer, if any exist.
717 The caller is responsible for ensuring PRINTER is a printer smob.
718 If PRINTED_NOTHING is true, then nothing has been printed by to_string,
719 and format output accordingly. */
720
721static void
722ppscm_print_children (SCM printer, enum display_hint hint,
723 struct ui_file *stream, int recurse,
724 const struct value_print_options *options,
725 struct gdbarch *gdbarch,
726 const struct language_defn *language,
727 int printed_nothing)
728{
730 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
731 int is_map, is_array, done_flag, pretty;
732 unsigned int i;
733 SCM children;
734 SCM iter = SCM_BOOL_F; /* -Wall */
735
736 if (gdbscm_is_false (w_smob->children))
737 return;
738 if (!gdbscm_is_procedure (w_smob->children))
739 {
741 (_("pretty-printer \"children\" object is not a procedure or #f"),
742 w_smob->children);
743 return;
744 }
745
746 /* If we are printing a map or an array, we want special formatting. */
747 is_map = hint == HINT_MAP;
748 is_array = hint == HINT_ARRAY;
749
750 children = gdbscm_safe_call_1 (w_smob->children, printer,
752 if (gdbscm_is_exception (children))
753 {
755 goto done;
756 }
757 /* We combine two steps here: get children, make an iterator out of them.
758 This simplifies things because there's no language means of creating
759 iterators, and it's the printer object that knows how it will want its
760 children iterated over. */
761 if (!itscm_is_iterator (children))
762 {
764 (_("result of pretty-printer \"children\" procedure is not"
765 " a <gdb:iterator> object"), children);
766 goto done;
767 }
768 iter = children;
769
770 /* Use the prettyformat_arrays option if we are printing an array,
771 and the pretty option otherwise. */
772 if (is_array)
773 pretty = options->prettyformat_arrays;
774 else
775 {
776 if (options->prettyformat == Val_prettyformat)
777 pretty = 1;
778 else
779 pretty = options->prettyformat_structs;
780 }
781
782 done_flag = 0;
783 for (i = 0; i < options->print_max; ++i)
784 {
785 SCM scm_name, v_scm;
787
788 if (gdbscm_is_exception (item))
789 {
791 break;
792 }
793 if (itscm_is_end_of_iteration (item))
794 {
795 /* Set a flag so we can know whether we printed all the
796 available elements. */
797 done_flag = 1;
798 break;
799 }
800
801 if (! scm_is_pair (item))
802 {
804 (_("result of pretty-printer children iterator is not a pair"
805 " or (end-of-iteration)"),
806 item);
807 continue;
808 }
809 scm_name = scm_car (item);
810 v_scm = scm_cdr (item);
811 if (!scm_is_string (scm_name))
812 {
814 (_("first element of pretty-printer children iterator is not"
815 " a string"), item);
816 continue;
817 }
818 gdb::unique_xmalloc_ptr<char> name
819 = gdbscm_scm_to_c_string (scm_name);
820
821 /* Print initial "=" to separate print_string_repr output and
822 children. For other elements, there are three cases:
823 1. Maps. Print a "," after each value element.
824 2. Arrays. Always print a ",".
825 3. Other. Always print a ",". */
826 if (i == 0)
827 {
828 if (!printed_nothing)
829 gdb_puts (" = ", stream);
830 }
831 else if (! is_map || i % 2 == 0)
832 gdb_puts (pretty ? "," : ", ", stream);
833
834 /* Skip printing children if max_depth has been reached. This check
835 is performed after print_string_repr and the "=" separator so that
836 these steps are not skipped if the variable is located within the
837 permitted depth. */
838 if (val_print_check_max_depth (stream, recurse, options, language))
839 goto done;
840 else if (i == 0)
841 /* Print initial "{" to bookend children. */
842 gdb_puts ("{", stream);
843
844 /* In summary mode, we just want to print "= {...}" if there is
845 a value. */
846 if (options->summary)
847 {
848 /* This increment tricks the post-loop logic to print what
849 we want. */
850 ++i;
851 /* Likewise. */
852 pretty = 0;
853 break;
854 }
855
856 if (! is_map || i % 2 == 0)
857 {
858 if (pretty)
859 {
860 gdb_puts ("\n", stream);
861 print_spaces (2 + 2 * recurse, stream);
862 }
863 else
864 stream->wrap_here (2 + 2 *recurse);
865 }
866
867 if (is_map && i % 2 == 0)
868 gdb_puts ("[", stream);
869 else if (is_array)
870 {
871 /* We print the index, not whatever the child method
872 returned as the name. */
873 if (options->print_array_indexes)
874 gdb_printf (stream, "[%d] = ", i);
875 }
876 else if (! is_map)
877 {
878 gdb_puts (name.get (), stream);
879 gdb_puts (" = ", stream);
880 }
881
882 if (lsscm_is_lazy_string (v_scm))
883 {
884 struct value_print_options local_opts = *options;
885
886 local_opts.addressprint = 0;
887 lsscm_val_print_lazy_string (v_scm, stream, &local_opts);
888 }
889 else if (scm_is_string (v_scm))
890 {
891 gdb::unique_xmalloc_ptr<char> output
892 = gdbscm_scm_to_c_string (v_scm);
893 gdb_puts (output.get (), stream);
894 }
895 else
896 {
897 SCM except_scm;
898 struct value *value
900 v_scm, &except_scm,
902
903 if (value == NULL)
904 {
906 break;
907 }
908 else
909 {
910 /* When printing the key of a map we allow one additional
911 level of depth. This means the key will print before the
912 value does. */
913 struct value_print_options opt = *options;
914 if (is_map && i % 2 == 0
915 && opt.max_depth != -1
916 && opt.max_depth < INT_MAX)
917 ++opt.max_depth;
918 common_val_print (value, stream, recurse + 1, &opt, language);
919 }
920 }
921
922 if (is_map && i % 2 == 0)
923 gdb_puts ("] = ", stream);
924 }
925
926 if (i)
927 {
928 if (!done_flag)
929 {
930 if (pretty)
931 {
932 gdb_puts ("\n", stream);
933 print_spaces (2 + 2 * recurse, stream);
934 }
935 gdb_puts ("...", stream);
936 }
937 if (pretty)
938 {
939 gdb_puts ("\n", stream);
940 print_spaces (2 * recurse, stream);
941 }
942 gdb_puts ("}", stream);
943 }
944
945 done:
946 /* Play it safe, make sure ITER doesn't get GC'd. */
947 scm_remember_upto_here_1 (iter);
948}
949
950/* This is the extension_language_ops.apply_val_pretty_printer "method". */
951
952enum ext_lang_rc
954 struct value *value,
955 struct ui_file *stream, int recurse,
956 const struct value_print_options *options,
957 const struct language_defn *language)
958{
959 struct type *type = value_type (value);
960 struct gdbarch *gdbarch = type->arch ();
961 SCM exception = SCM_BOOL_F;
962 SCM printer = SCM_BOOL_F;
963 SCM val_obj = SCM_BOOL_F;
964 enum display_hint hint;
965 enum ext_lang_rc result = EXT_LANG_RC_NOP;
966 enum guile_string_repr_result print_result;
967
968 if (value_lazy (value))
970
971 /* No pretty-printer support for unavailable values. */
972 if (!value_bytes_available (value, 0, type->length ()))
973 return EXT_LANG_RC_NOP;
974
976 return EXT_LANG_RC_NOP;
977
978 /* Instantiate the printer. */
980 if (gdbscm_is_exception (val_obj))
981 {
982 exception = val_obj;
983 result = EXT_LANG_RC_ERROR;
984 goto done;
985 }
986
987 printer = ppscm_find_pretty_printer (val_obj);
988
989 if (gdbscm_is_exception (printer))
990 {
991 exception = printer;
992 result = EXT_LANG_RC_ERROR;
993 goto done;
994 }
995 if (gdbscm_is_false (printer))
996 {
997 result = EXT_LANG_RC_NOP;
998 goto done;
999 }
1000 gdb_assert (ppscm_is_pretty_printer_worker (printer));
1001
1002 /* If we are printing a map, we want some special formatting. */
1003 hint = ppscm_get_display_hint_enum (printer);
1004 if (hint == HINT_ERROR)
1005 {
1006 /* Print the error as an exception for consistency. */
1007 SCM hint_scm = ppscm_get_display_hint_scm (printer);
1008
1009 ppscm_print_pp_type_error ("Invalid display hint", hint_scm);
1010 /* Fall through. A bad hint doesn't stop pretty-printing. */
1011 hint = HINT_NONE;
1012 }
1013
1014 /* Print the section. */
1015 print_result = ppscm_print_string_repr (printer, hint, stream, recurse,
1016 options, gdbarch, language);
1017 if (print_result != STRING_REPR_ERROR)
1018 {
1019 ppscm_print_children (printer, hint, stream, recurse, options,
1021 print_result == STRING_REPR_NONE);
1022 }
1023
1024 result = EXT_LANG_RC_OK;
1025
1026 done:
1027 if (gdbscm_is_exception (exception))
1029 return result;
1030}
1031
1032/* Initialize the Scheme pretty-printer code. */
1033
1035{
1036 { "make-pretty-printer", 2, 0, 0,
1038 "\
1039Create a <gdb:pretty-printer> object.\n\
1040\n\
1041 Arguments: name lookup\n\
1042 name: a string naming the matcher\n\
1043 lookup: a procedure:\n\
1044 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1045
1046 { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p),
1047 "\
1048Return #t if the object is a <gdb:pretty-printer> object." },
1049
1050 { "pretty-printer-enabled?", 1, 0, 0,
1052 "\
1053Return #t if the pretty-printer is enabled." },
1054
1055 { "set-pretty-printer-enabled!", 2, 0, 0,
1057 "\
1058Set the enabled flag of the pretty-printer.\n\
1059Returns \"unspecified\"." },
1060
1061 { "make-pretty-printer-worker", 3, 0, 0,
1063 "\
1064Create a <gdb:pretty-printer-worker> object.\n\
1065\n\
1066 Arguments: display-hint to-string children\n\
1067 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1068 to-string: a procedure:\n\
1069 (pretty-printer) -> string | #f | <gdb:value>\n\
1070 children: either #f or a procedure:\n\
1071 (pretty-printer) -> <gdb:iterator>" },
1072
1073 { "pretty-printer-worker?", 1, 0, 0,
1075 "\
1076Return #t if the object is a <gdb:pretty-printer-worker> object." },
1077
1078 { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers),
1079 "\
1080Return the list of global pretty-printers." },
1081
1082 { "set-pretty-printers!", 1, 0, 0,
1084 "\
1085Set the list of global pretty-printers." },
1086
1088};
1089
1090void
1092{
1095 sizeof (pretty_printer_smob));
1096 scm_set_smob_print (pretty_printer_smob_tag,
1098
1102 scm_set_smob_print (pretty_printer_worker_smob_tag,
1104
1106
1107 pretty_printer_list = SCM_EOL;
1108
1109 pp_type_error_symbol = scm_from_latin1_symbol ("gdb:pp-type-error");
1110
1111 ppscm_map_string = scm_from_latin1_string ("map");
1112 ppscm_array_string = scm_from_latin1_string ("array");
1113 ppscm_string_string = scm_from_latin1_string ("string");
1114}
constexpr string_view get()
Definition: 70483.cc:49
const char *const name
Definition: aarch64-tdep.c:67
static struct parser_state * pstate
Definition: ada-exp.c:104
const char * target_charset(struct gdbarch *gdbarch)
Definition: charset.c:424
virtual void wrap_here(int indent)
Definition: ui-file.h:117
@ Val_prettyformat
Definition: defs.h:423
#define INT_MAX
Definition: defs.h:457
language
Definition: defs.h:211
ext_lang_rc
Definition: extension.h:165
@ EXT_LANG_RC_NOP
Definition: extension.h:170
@ EXT_LANG_RC_OK
Definition: extension.h:167
@ EXT_LANG_RC_ERROR
Definition: extension.h:179
#define gdbscm_is_true(scm)
struct value * vlscm_convert_value_from_scheme(const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp, struct gdbarch *gdbarch, const struct language_defn *language)
Definition: scm-math.c:855
#define GDBSCM_ARG_NONE
SCM vlscm_scm_from_value_no_release(struct value *value)
Definition: scm-value.c:268
#define END_FUNCTIONS
void lsscm_val_print_lazy_string(SCM string, struct ui_file *stream, const struct value_print_options *options)
objfile_smob * ofscm_objfile_smob_from_objfile(struct objfile *objfile)
Definition: scm-objfile.c:136
int vlscm_is_value(SCM scm)
Definition: scm-value.c:233
int gdbscm_is_procedure(SCM proc)
Definition: scm-utils.c:592
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:140
void gdbscm_print_gdb_exception(SCM port, SCM exception)
SCM ofscm_objfile_smob_pretty_printers(objfile_smob *o_smob)
Definition: scm-objfile.c:68
gdb::unique_xmalloc_ptr< char > gdbscm_exception_message_to_string(SCM exception)
SCM gdbscm_exception_key(SCM excp)
int lsscm_is_lazy_string(SCM scm)
SCM gdbscm_safe_call_2(SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
SCM gdbscm_safe_call_1(SCM proc, SCM arg0, excp_matcher_func *ok_excps)
excp_matcher_func gdbscm_memory_error_p
SCM itscm_safe_call_next_x(SCM iter, excp_matcher_func *ok_excps)
Definition: scm-iterator.c:214
#define gdbscm_is_false(scm)
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
SCM gdb::unique_xmalloc_ptr< char > gdbscm_scm_to_string(SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp)
Definition: scm-string.c:117
gdb::unique_xmalloc_ptr< char > gdbscm_scm_to_c_string(SCM string)
Definition: scm-string.c:55
int itscm_is_iterator(SCM scm)
Definition: scm-iterator.c:171
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
int gdbscm_is_exception(SCM scm)
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
int itscm_is_end_of_iteration(SCM obj)
Definition: scm-iterator.c:196
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:103
SCM psscm_pspace_smob_pretty_printers(const pspace_smob *)
Definition: scm-progspace.c:71
pspace_smob * psscm_pspace_smob_from_pspace(struct program_space *)
int gdb_scheme_initialized
static scm_t_subr as_a_scm_t_subr(SCM(*func)(void))
#define FUNC_NAME
SCM gdbscm_make_error(SCM key, const char *subr, const char *message, SCM args, SCM data)
struct program_space * current_program_space
Definition: progspace.c:39
static SCM ppscm_get_pretty_printer_arg_unsafe(SCM self, int arg_pos, const char *func_name)
static void ppscm_print_pp_type_error(const char *message, SCM object)
static void ppscm_print_children(SCM printer, enum display_hint hint, struct ui_file *stream, int recurse, const struct value_print_options *options, struct gdbarch *gdbarch, const struct language_defn *language, int printed_nothing)
display_hint
@ HINT_ARRAY
@ HINT_NONE
@ HINT_MAP
@ HINT_ERROR
@ HINT_STRING
static SCM ppscm_map_string
static int ppscm_is_pretty_printer_worker(SCM scm)
static scm_t_bits pretty_printer_worker_smob_tag
static SCM ppscm_find_pretty_printer_from_gdb(SCM value)
static int ppscm_print_pretty_printer_smob(SCM self, SCM port, scm_print_state *pstate)
static pretty_printer_smob * ppscm_get_pretty_printer_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
static enum display_hint ppscm_get_display_hint_enum(SCM printer)
static const char pretty_printer_worker_smob_name[]
static SCM ppscm_array_string
static enum guile_string_repr_result ppscm_print_string_repr(SCM printer, enum display_hint hint, struct ui_file *stream, int recurse, const struct value_print_options *options, struct gdbarch *gdbarch, const struct language_defn *language)
static SCM gdbscm_pretty_printers(void)
guile_string_repr_result
@ STRING_REPR_ERROR
@ STRING_REPR_OK
@ STRING_REPR_NONE
static SCM ppscm_search_pp_list(SCM list, SCM value)
static const char pretty_printer_smob_name[]
enum ext_lang_rc gdbscm_apply_val_pretty_printer(const struct extension_language_defn *extlang, struct value *value, struct ui_file *stream, int recurse, const struct value_print_options *options, const struct language_defn *language)
static SCM gdbscm_make_pretty_printer(SCM name, SCM lookup)
static SCM ppscm_find_pretty_printer(SCM value)
static SCM ppscm_get_display_hint_scm(SCM printer)
static SCM gdbscm_pretty_printer_enabled_p(SCM self)
static void ppscm_print_exception_unless_memory_error(SCM exception, struct ui_file *stream)
static SCM ppscm_string_string
static SCM gdbscm_pretty_printer_worker_p(SCM scm)
static SCM gdbscm_set_pretty_printer_enabled_x(SCM self, SCM enabled)
void gdbscm_initialize_pretty_printers(void)
static SCM gdbscm_make_pretty_printer_worker(SCM display_hint, SCM to_string, SCM children)
static int ppscm_is_pretty_printer(SCM scm)
static SCM ppscm_pretty_print_one_value(SCM printer, struct value **out_value, struct gdbarch *gdbarch, const struct language_defn *language)
static SCM ppscm_make_pp_type_error_exception(const char *message, SCM object)
static SCM ppscm_find_pretty_printer_from_objfiles(SCM value)
static const scheme_function pretty_printer_functions[]
static SCM ppscm_find_pretty_printer_from_progspace(SCM value)
static SCM gdbscm_pretty_printer_p(SCM scm)
static SCM pretty_printer_list
static scm_t_bits pretty_printer_smob_tag
static SCM pp_type_error_symbol
static int ppscm_print_pretty_printer_worker_smob(SCM self, SCM port, scm_print_state *pstate)
static SCM gdbscm_set_pretty_printers_x(SCM printers)
struct type * builtin_char
Definition: gdbtypes.h:2246
objfiles_range objfiles()
Definition: progspace.h:209
Definition: gdbtypes.h:922
ULONGEST length() const
Definition: gdbtypes.h:954
gdbarch * arch() const
Definition: gdbtypes.c:245
bool print_array_indexes
Definition: valprint.h:79
bool prettyformat_arrays
Definition: valprint.h:33
unsigned int print_max
Definition: valprint.h:58
enum val_prettyformat prettyformat
Definition: valprint.h:30
bool prettyformat_structs
Definition: valprint.h:36
Definition: value.c:181
void print_spaces(int n, struct ui_file *stream)
Definition: utils.c:1947
void gdb_putc(int c)
Definition: utils.c:1841
void gdb_printf(struct ui_file *stream, const char *format,...)
Definition: utils.c:1865
void gdb_puts(const char *linebuffer, struct ui_file *stream)
Definition: utils.c:1788
bool val_print_check_max_depth(struct ui_file *stream, int recurse, const struct value_print_options *options, const struct language_defn *language)
Definition: valprint.c:1085
void common_val_print(struct value *value, struct ui_file *stream, int recurse, const struct value_print_options *options, const struct language_defn *language)
Definition: valprint.c:1014
int value_bytes_available(const struct value *value, LONGEST offset, LONGEST length)
Definition: value.c:391
struct type * value_type(const struct value *value)
Definition: value.c:1109
int value_lazy(const struct value *value)
Definition: value.c:1440
void value_fetch_lazy(struct value *val)
Definition: value.c:4162