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