1 /* GDB/Scheme pretty-printing.
3 Copyright (C) 2008-2018 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
25 #include "symtab.h" /* Needed by language.h. */
30 #include "guile-internal.h"
32 /* Return type of print_string_repr. */
34 enum string_repr_result
36 /* The string method returned None. */
38 /* The string method had an error. */
48 /* No display hint. */
50 /* The display hint has a bad value. */
52 /* Print as an array. */
56 /* Print as a string. */
60 /* The <gdb:pretty-printer> smob. */
64 /* This must appear first. */
67 /* A string representing the name of the printer. */
70 /* A boolean indicating whether the printer is enabled. */
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. */
79 /* Note: Attaching subprinters to this smob is left to Scheme. */
80 } pretty_printer_smob
;
82 /* The <gdb:pretty-printer-worker> smob. */
86 /* This must appear first. */
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). */
93 /* A procedure called to pretty-print the value.
94 (lambda (printer) ...) -> string | <gdb:lazy-string> | <gdb:value> */
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 } pretty_printer_worker_smob
;
104 static const char pretty_printer_smob_name
[] =
105 "gdb:pretty-printer";
106 static const char pretty_printer_worker_smob_name
[] =
107 "gdb:pretty-printer-worker";
109 /* The tag Guile knows the pretty-printer smobs by. */
110 static scm_t_bits pretty_printer_smob_tag
;
111 static scm_t_bits pretty_printer_worker_smob_tag
;
113 /* The global pretty-printer list. */
114 static SCM pretty_printer_list
;
116 /* gdb:pp-type-error. */
117 static SCM pp_type_error_symbol
;
119 /* Pretty-printer display hints are specified by strings. */
120 static SCM ppscm_map_string
;
121 static SCM ppscm_array_string
;
122 static SCM ppscm_string_string
;
124 /* Administrivia for pretty-printer matcher smobs. */
126 /* The smob "print" function for <gdb:pretty-printer>. */
129 ppscm_print_pretty_printer_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
131 pretty_printer_smob
*pp_smob
= (pretty_printer_smob
*) SCM_SMOB_DATA (self
);
133 gdbscm_printf (port
, "#<%s ", pretty_printer_smob_name
);
134 scm_write (pp_smob
->name
, port
);
135 scm_puts (gdbscm_is_true (pp_smob
->enabled
) ? " enabled" : " disabled",
137 scm_puts (">", port
);
139 scm_remember_upto_here_1 (self
);
141 /* Non-zero means success. */
145 /* (make-pretty-printer string procedure) -> <gdb:pretty-printer> */
148 gdbscm_make_pretty_printer (SCM name
, SCM lookup
)
150 pretty_printer_smob
*pp_smob
= (pretty_printer_smob
*)
151 scm_gc_malloc (sizeof (pretty_printer_smob
),
152 pretty_printer_smob_name
);
155 SCM_ASSERT_TYPE (scm_is_string (name
), name
, SCM_ARG1
, FUNC_NAME
,
157 SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup
), lookup
, SCM_ARG2
, FUNC_NAME
,
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
);
169 /* Return non-zero if SCM is a <gdb:pretty-printer> object. */
172 ppscm_is_pretty_printer (SCM scm
)
174 return SCM_SMOB_PREDICATE (pretty_printer_smob_tag
, scm
);
177 /* (pretty-printer? object) -> boolean */
180 gdbscm_pretty_printer_p (SCM scm
)
182 return scm_from_bool (ppscm_is_pretty_printer (scm
));
185 /* Returns the <gdb:pretty-printer> object in SELF.
186 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
189 ppscm_get_pretty_printer_arg_unsafe (SCM self
, int arg_pos
,
190 const char *func_name
)
192 SCM_ASSERT_TYPE (ppscm_is_pretty_printer (self
), self
, arg_pos
, func_name
,
193 pretty_printer_smob_name
);
198 /* Returns a pointer to the pretty-printer smob of SELF.
199 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
201 static pretty_printer_smob
*
202 ppscm_get_pretty_printer_smob_arg_unsafe (SCM self
, int arg_pos
,
203 const char *func_name
)
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
);
212 /* Pretty-printer methods. */
214 /* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
217 gdbscm_pretty_printer_enabled_p (SCM self
)
219 pretty_printer_smob
*pp_smob
220 = ppscm_get_pretty_printer_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
222 return pp_smob
->enabled
;
225 /* (set-pretty-printer-enabled! <gdb:pretty-printer> boolean)
229 gdbscm_set_pretty_printer_enabled_x (SCM self
, SCM enabled
)
231 pretty_printer_smob
*pp_smob
232 = ppscm_get_pretty_printer_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
234 pp_smob
->enabled
= scm_from_bool (gdbscm_is_true (enabled
));
236 return SCM_UNSPECIFIED
;
239 /* (pretty-printers) -> list
240 Returns the list of global pretty-printers. */
243 gdbscm_pretty_printers (void)
245 return pretty_printer_list
;
248 /* (set-pretty-printers! list) -> unspecified
249 Set the global pretty-printers list. */
252 gdbscm_set_pretty_printers_x (SCM printers
)
254 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers
)), printers
,
255 SCM_ARG1
, FUNC_NAME
, _("list"));
257 pretty_printer_list
= printers
;
259 return SCM_UNSPECIFIED
;
262 /* Administrivia for pretty-printer-worker smobs.
263 These are created when a matcher recognizes a value. */
265 /* The smob "print" function for <gdb:pretty-printer-worker>. */
268 ppscm_print_pretty_printer_worker_smob (SCM self
, SCM port
,
269 scm_print_state
*pstate
)
271 pretty_printer_worker_smob
*w_smob
272 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (self
);
274 gdbscm_printf (port
, "#<%s ", pretty_printer_worker_smob_name
);
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
);
282 scm_remember_upto_here_1 (self
);
284 /* Non-zero means success. */
288 /* (make-pretty-printer-worker string procedure procedure)
289 -> <gdb:pretty-printer-worker> */
292 gdbscm_make_pretty_printer_worker (SCM display_hint
, SCM to_string
,
295 pretty_printer_worker_smob
*w_smob
= (pretty_printer_worker_smob
*)
296 scm_gc_malloc (sizeof (pretty_printer_worker_smob
),
297 pretty_printer_worker_smob_name
);
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
);
308 /* Return non-zero if SCM is a <gdb:pretty-printer-worker> object. */
311 ppscm_is_pretty_printer_worker (SCM scm
)
313 return SCM_SMOB_PREDICATE (pretty_printer_worker_smob_tag
, scm
);
316 /* (pretty-printer-worker? object) -> boolean */
319 gdbscm_pretty_printer_worker_p (SCM scm
)
321 return scm_from_bool (ppscm_is_pretty_printer_worker (scm
));
324 /* Helper function to create a <gdb:exception> object indicating that the
325 type of some value returned from a pretty-printer is invalid. */
328 ppscm_make_pp_type_error_exception (const char *message
, SCM object
)
330 std::string msg
= string_printf ("%s: ~S", message
);
331 return gdbscm_make_error (pp_type_error_symbol
,
332 NULL
/* func */, msg
.c_str (),
333 scm_list_1 (object
), scm_list_1 (object
));
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
342 ppscm_print_pp_type_error (const char *message
, SCM object
)
344 SCM exception
= ppscm_make_pp_type_error_exception (message
, object
);
346 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
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>
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
361 ppscm_search_pp_list (SCM list
, SCM value
)
363 SCM orig_list
= list
;
365 if (scm_is_null (list
))
367 if (gdbscm_is_false (scm_list_p (list
))) /* scm_is_pair? */
369 return ppscm_make_pp_type_error_exception
370 (_("pretty-printer list is not a list"), list
);
373 for ( ; scm_is_pair (list
); list
= scm_cdr (list
))
375 SCM matcher
= scm_car (list
);
377 pretty_printer_smob
*pp_smob
;
379 if (!ppscm_is_pretty_printer (matcher
))
381 return ppscm_make_pp_type_error_exception
382 (_("pretty-printer list contains non-pretty-printer object"),
386 pp_smob
= (pretty_printer_smob
*) SCM_SMOB_DATA (matcher
);
388 /* Skip if disabled. */
389 if (gdbscm_is_false (pp_smob
->enabled
))
392 if (!gdbscm_is_procedure (pp_smob
->lookup
))
394 return ppscm_make_pp_type_error_exception
395 (_("invalid lookup object in pretty-printer matcher"),
399 worker
= gdbscm_safe_call_2 (pp_smob
->lookup
, matcher
,
400 value
, gdbscm_memory_error_p
);
401 if (!gdbscm_is_false (worker
))
403 if (gdbscm_is_exception (worker
))
405 if (ppscm_is_pretty_printer_worker (worker
))
407 return ppscm_make_pp_type_error_exception
408 (_("invalid result from pretty-printer lookup"), worker
);
412 if (!scm_is_null (list
))
414 return ppscm_make_pp_type_error_exception
415 (_("pretty-printer list is not a list"), orig_list
);
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. */
428 ppscm_find_pretty_printer_from_objfiles (SCM value
)
430 struct objfile
*objfile
;
432 ALL_OBJFILES (objfile
)
434 objfile_smob
*o_smob
= ofscm_objfile_smob_from_objfile (objfile
);
435 SCM pp
= ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob
),
438 /* Note: This will return if pp is a <gdb:exception> object,
439 which is what we want. */
440 if (gdbscm_is_true (pp
))
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. */
454 ppscm_find_pretty_printer_from_progspace (SCM value
)
456 pspace_smob
*p_smob
= psscm_pspace_smob_from_pspace (current_program_space
);
458 = ppscm_search_pp_list (psscm_pspace_smob_pretty_printers (p_smob
), value
);
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. */
470 ppscm_find_pretty_printer_from_gdb (SCM value
)
472 SCM pp
= ppscm_search_pp_list (pretty_printer_list
, value
);
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
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. */
486 ppscm_find_pretty_printer (SCM value
)
490 /* Look at the pretty-printer list for each objfile
491 in the current program-space. */
492 pp
= ppscm_find_pretty_printer_from_objfiles (value
);
493 /* Note: This will return if function is a <gdb:exception> object,
494 which is what we want. */
495 if (gdbscm_is_true (pp
))
498 /* Look at the pretty-printer list for the current program-space. */
499 pp
= ppscm_find_pretty_printer_from_progspace (value
);
500 /* Note: This will return if function is a <gdb:exception> object,
501 which is what we want. */
502 if (gdbscm_is_true (pp
))
505 /* Look at the pretty-printer list in the gdb module. */
506 pp
= ppscm_find_pretty_printer_from_gdb (value
);
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. */
521 ppscm_pretty_print_one_value (SCM printer
, struct value
**out_value
,
522 struct gdbarch
*gdbarch
,
523 const struct language_defn
*language
)
525 SCM result
= SCM_BOOL_F
;
530 pretty_printer_worker_smob
*w_smob
531 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
533 result
= gdbscm_safe_call_1 (w_smob
->to_string
, printer
,
534 gdbscm_memory_error_p
);
535 if (gdbscm_is_false (result
))
537 else if (scm_is_string (result
)
538 || lsscm_is_lazy_string (result
))
540 else if (vlscm_is_value (result
))
545 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
548 if (*out_value
!= NULL
)
553 else if (gdbscm_is_exception (result
))
557 /* Invalid result from to-string. */
558 result
= ppscm_make_pp_type_error_exception
559 (_("invalid result from pretty-printer to-string"), result
);
562 CATCH (except
, RETURN_MASK_ALL
)
570 /* Return the display hint for PRINTER as a Scheme object.
571 The caller is responsible for ensuring PRINTER is a
572 <gdb:pretty-printer-worker> object. */
575 ppscm_get_display_hint_scm (SCM printer
)
577 pretty_printer_worker_smob
*w_smob
578 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
580 return w_smob
->display_hint
;
583 /* Return the display hint for the pretty-printer PRINTER.
584 The caller is responsible for ensuring PRINTER is a
585 <gdb:pretty-printer-worker> object.
586 Returns the display hint or #f if the hint is not a string. */
588 static enum display_hint
589 ppscm_get_display_hint_enum (SCM printer
)
591 SCM hint
= ppscm_get_display_hint_scm (printer
);
593 if (gdbscm_is_false (hint
))
595 if (scm_is_string (hint
))
597 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_array_string
)))
599 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_map_string
)))
601 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_string_string
)))
608 /* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
609 EXCEPTION is a <gdb:exception> object. */
612 ppscm_print_exception_unless_memory_error (SCM exception
,
613 struct ui_file
*stream
)
615 if (gdbscm_memory_error_p (gdbscm_exception_key (exception
)))
617 gdb::unique_xmalloc_ptr
<char> msg
618 = gdbscm_exception_message_to_string (exception
);
620 /* This "shouldn't happen", but play it safe. */
621 if (msg
== NULL
|| msg
.get ()[0] == '\0')
622 fprintf_filtered (stream
, _("<error reading variable>"));
625 /* Remove the trailing newline. We could instead call a special
626 routine for printing memory error messages, but this is easy
628 char *msg_text
= msg
.get ();
629 size_t len
= strlen (msg_text
);
631 if (msg_text
[len
- 1] == '\n')
632 msg_text
[len
- 1] = '\0';
633 fprintf_filtered (stream
, _("<error reading variable: %s>"), msg_text
);
637 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
640 /* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
641 formats the result. */
643 static enum string_repr_result
644 ppscm_print_string_repr (SCM printer
, enum display_hint hint
,
645 struct ui_file
*stream
, int recurse
,
646 const struct value_print_options
*options
,
647 struct gdbarch
*gdbarch
,
648 const struct language_defn
*language
)
650 struct value
*replacement
= NULL
;
652 enum string_repr_result result
= STRING_REPR_ERROR
;
654 str_scm
= ppscm_pretty_print_one_value (printer
, &replacement
,
656 if (gdbscm_is_false (str_scm
))
658 result
= STRING_REPR_NONE
;
660 else if (scm_is_eq (str_scm
, SCM_BOOL_T
))
662 struct value_print_options opts
= *options
;
664 gdb_assert (replacement
!= NULL
);
665 opts
.addressprint
= 0;
666 common_val_print (replacement
, stream
, recurse
, &opts
, language
);
667 result
= STRING_REPR_OK
;
669 else if (scm_is_string (str_scm
))
671 struct cleanup
*cleanup
;
674 = gdbscm_scm_to_string (str_scm
, &length
,
675 target_charset (gdbarch
), 0 /*!strict*/, NULL
);
677 cleanup
= make_cleanup (xfree
, string
);
678 if (hint
== HINT_STRING
)
680 struct type
*type
= builtin_type (gdbarch
)->builtin_char
;
682 LA_PRINT_STRING (stream
, type
, (gdb_byte
*) string
,
683 length
, NULL
, 0, options
);
687 /* Alas scm_to_stringn doesn't nul-terminate the string if we
688 ask for the length. */
691 for (i
= 0; i
< length
; ++i
)
693 if (string
[i
] == '\0')
694 fputs_filtered ("\\000", stream
);
696 fputc_filtered (string
[i
], stream
);
699 result
= STRING_REPR_OK
;
700 do_cleanups (cleanup
);
702 else if (lsscm_is_lazy_string (str_scm
))
704 struct value_print_options local_opts
= *options
;
706 local_opts
.addressprint
= 0;
707 lsscm_val_print_lazy_string (str_scm
, stream
, &local_opts
);
708 result
= STRING_REPR_OK
;
712 gdb_assert (gdbscm_is_exception (str_scm
));
713 ppscm_print_exception_unless_memory_error (str_scm
, stream
);
714 result
= STRING_REPR_ERROR
;
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. */
727 ppscm_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
,
734 pretty_printer_worker_smob
*w_smob
735 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
736 int is_map
, is_array
, done_flag
, pretty
;
739 SCM iter
= SCM_BOOL_F
; /* -Wall */
740 struct cleanup
*cleanups
;
742 if (gdbscm_is_false (w_smob
->children
))
744 if (!gdbscm_is_procedure (w_smob
->children
))
746 ppscm_print_pp_type_error
747 (_("pretty-printer \"children\" object is not a procedure or #f"),
752 cleanups
= make_cleanup (null_cleanup
, NULL
);
754 /* If we are printing a map or an array, we want special formatting. */
755 is_map
= hint
== HINT_MAP
;
756 is_array
= hint
== HINT_ARRAY
;
758 children
= gdbscm_safe_call_1 (w_smob
->children
, printer
,
759 gdbscm_memory_error_p
);
760 if (gdbscm_is_exception (children
))
762 ppscm_print_exception_unless_memory_error (children
, stream
);
765 /* We combine two steps here: get children, make an iterator out of them.
766 This simplifies things because there's no language means of creating
767 iterators, and it's the printer object that knows how it will want its
768 children iterated over. */
769 if (!itscm_is_iterator (children
))
771 ppscm_print_pp_type_error
772 (_("result of pretty-printer \"children\" procedure is not"
773 " a <gdb:iterator> object"), children
);
778 /* Use the prettyformat_arrays option if we are printing an array,
779 and the pretty option otherwise. */
781 pretty
= options
->prettyformat_arrays
;
784 if (options
->prettyformat
== Val_prettyformat
)
787 pretty
= options
->prettyformat_structs
;
791 for (i
= 0; i
< options
->print_max
; ++i
)
795 SCM item
= itscm_safe_call_next_x (iter
, gdbscm_memory_error_p
);
796 struct cleanup
*inner_cleanup
= make_cleanup (null_cleanup
, NULL
);
798 if (gdbscm_is_exception (item
))
800 ppscm_print_exception_unless_memory_error (item
, stream
);
803 if (itscm_is_end_of_iteration (item
))
805 /* Set a flag so we can know whether we printed all the
806 available elements. */
811 if (! scm_is_pair (item
))
813 ppscm_print_pp_type_error
814 (_("result of pretty-printer children iterator is not a pair"
815 " or (end-of-iteration)"),
819 scm_name
= scm_car (item
);
820 v_scm
= scm_cdr (item
);
821 if (!scm_is_string (scm_name
))
823 ppscm_print_pp_type_error
824 (_("first element of pretty-printer children iterator is not"
828 name
= gdbscm_scm_to_c_string (scm_name
);
829 make_cleanup (xfree
, name
);
831 /* Print initial "{". For other elements, there are three cases:
832 1. Maps. Print a "," after each value element.
833 2. Arrays. Always print a ",".
834 3. Other. Always print a ",". */
838 fputs_filtered ("{", stream
);
840 fputs_filtered (" = {", stream
);
843 else if (! is_map
|| i
% 2 == 0)
844 fputs_filtered (pretty
? "," : ", ", stream
);
846 /* In summary mode, we just want to print "= {...}" if there is
848 if (options
->summary
)
850 /* This increment tricks the post-loop logic to print what
858 if (! is_map
|| i
% 2 == 0)
862 fputs_filtered ("\n", stream
);
863 print_spaces_filtered (2 + 2 * recurse
, stream
);
866 wrap_here (n_spaces (2 + 2 *recurse
));
869 if (is_map
&& i
% 2 == 0)
870 fputs_filtered ("[", stream
);
873 /* We print the index, not whatever the child method
874 returned as the name. */
875 if (options
->print_array_indexes
)
876 fprintf_filtered (stream
, "[%d] = ", i
);
880 fputs_filtered (name
, stream
);
881 fputs_filtered (" = ", stream
);
884 if (lsscm_is_lazy_string (v_scm
))
886 struct value_print_options local_opts
= *options
;
888 local_opts
.addressprint
= 0;
889 lsscm_val_print_lazy_string (v_scm
, stream
, &local_opts
);
891 else if (scm_is_string (v_scm
))
893 char *output
= gdbscm_scm_to_c_string (v_scm
);
895 fputs_filtered (output
, stream
);
902 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
908 ppscm_print_exception_unless_memory_error (except_scm
, stream
);
911 common_val_print (value
, stream
, recurse
+ 1, options
, language
);
914 if (is_map
&& i
% 2 == 0)
915 fputs_filtered ("] = ", stream
);
917 do_cleanups (inner_cleanup
);
926 fputs_filtered ("\n", stream
);
927 print_spaces_filtered (2 + 2 * recurse
, stream
);
929 fputs_filtered ("...", stream
);
933 fputs_filtered ("\n", stream
);
934 print_spaces_filtered (2 * recurse
, stream
);
936 fputs_filtered ("}", stream
);
940 do_cleanups (cleanups
);
942 /* Play it safe, make sure ITER doesn't get GC'd. */
943 scm_remember_upto_here_1 (iter
);
946 /* This is the extension_language_ops.apply_val_pretty_printer "method". */
949 gdbscm_apply_val_pretty_printer (const struct extension_language_defn
*extlang
,
951 LONGEST embedded_offset
, CORE_ADDR address
,
952 struct ui_file
*stream
, int recurse
,
954 const struct value_print_options
*options
,
955 const struct language_defn
*language
)
957 struct gdbarch
*gdbarch
= get_type_arch (type
);
958 SCM exception
= SCM_BOOL_F
;
959 SCM printer
= SCM_BOOL_F
;
960 SCM val_obj
= SCM_BOOL_F
;
962 enum display_hint hint
;
963 struct cleanup
*cleanups
;
964 enum ext_lang_rc result
= EXT_LANG_RC_NOP
;
965 enum string_repr_result print_result
;
966 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
968 /* No pretty-printer support for unavailable values. */
969 if (!value_bytes_available (val
, embedded_offset
, TYPE_LENGTH (type
)))
970 return EXT_LANG_RC_NOP
;
972 if (!gdb_scheme_initialized
)
973 return EXT_LANG_RC_NOP
;
975 cleanups
= make_cleanup (null_cleanup
, NULL
);
977 /* Instantiate the printer. */
978 value
= value_from_component (val
, type
, embedded_offset
);
980 val_obj
= vlscm_scm_from_value (value
);
981 if (gdbscm_is_exception (val_obj
))
984 result
= EXT_LANG_RC_ERROR
;
988 printer
= ppscm_find_pretty_printer (val_obj
);
990 if (gdbscm_is_exception (printer
))
993 result
= EXT_LANG_RC_ERROR
;
996 if (gdbscm_is_false (printer
))
998 result
= EXT_LANG_RC_NOP
;
1001 gdb_assert (ppscm_is_pretty_printer_worker (printer
));
1003 /* If we are printing a map, we want some special formatting. */
1004 hint
= ppscm_get_display_hint_enum (printer
);
1005 if (hint
== HINT_ERROR
)
1007 /* Print the error as an exception for consistency. */
1008 SCM hint_scm
= ppscm_get_display_hint_scm (printer
);
1010 ppscm_print_pp_type_error ("Invalid display hint", hint_scm
);
1011 /* Fall through. A bad hint doesn't stop pretty-printing. */
1015 /* Print the section. */
1016 print_result
= ppscm_print_string_repr (printer
, hint
, stream
, recurse
,
1017 options
, gdbarch
, language
);
1018 if (print_result
!= STRING_REPR_ERROR
)
1020 ppscm_print_children (printer
, hint
, stream
, recurse
, options
,
1022 print_result
== STRING_REPR_NONE
);
1025 result
= EXT_LANG_RC_OK
;
1028 if (gdbscm_is_exception (exception
))
1029 ppscm_print_exception_unless_memory_error (exception
, stream
);
1030 do_cleanups (cleanups
);
1034 /* Initialize the Scheme pretty-printer code. */
1036 static const scheme_function pretty_printer_functions
[] =
1038 { "make-pretty-printer", 2, 0, 0,
1039 as_a_scm_t_subr (gdbscm_make_pretty_printer
),
1041 Create a <gdb:pretty-printer> object.\n\
1043 Arguments: name lookup\n\
1044 name: a string naming the matcher\n\
1045 lookup: a procedure:\n\
1046 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1048 { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p
),
1050 Return #t if the object is a <gdb:pretty-printer> object." },
1052 { "pretty-printer-enabled?", 1, 0, 0,
1053 as_a_scm_t_subr (gdbscm_pretty_printer_enabled_p
),
1055 Return #t if the pretty-printer is enabled." },
1057 { "set-pretty-printer-enabled!", 2, 0, 0,
1058 as_a_scm_t_subr (gdbscm_set_pretty_printer_enabled_x
),
1060 Set the enabled flag of the pretty-printer.\n\
1061 Returns \"unspecified\"." },
1063 { "make-pretty-printer-worker", 3, 0, 0,
1064 as_a_scm_t_subr (gdbscm_make_pretty_printer_worker
),
1066 Create a <gdb:pretty-printer-worker> object.\n\
1068 Arguments: display-hint to-string children\n\
1069 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1070 to-string: a procedure:\n\
1071 (pretty-printer) -> string | #f | <gdb:value>\n\
1072 children: either #f or a procedure:\n\
1073 (pretty-printer) -> <gdb:iterator>" },
1075 { "pretty-printer-worker?", 1, 0, 0,
1076 as_a_scm_t_subr (gdbscm_pretty_printer_worker_p
),
1078 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1080 { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers
),
1082 Return the list of global pretty-printers." },
1084 { "set-pretty-printers!", 1, 0, 0,
1085 as_a_scm_t_subr (gdbscm_set_pretty_printers_x
),
1087 Set the list of global pretty-printers." },
1093 gdbscm_initialize_pretty_printers (void)
1095 pretty_printer_smob_tag
1096 = gdbscm_make_smob_type (pretty_printer_smob_name
,
1097 sizeof (pretty_printer_smob
));
1098 scm_set_smob_print (pretty_printer_smob_tag
,
1099 ppscm_print_pretty_printer_smob
);
1101 pretty_printer_worker_smob_tag
1102 = gdbscm_make_smob_type (pretty_printer_worker_smob_name
,
1103 sizeof (pretty_printer_worker_smob
));
1104 scm_set_smob_print (pretty_printer_worker_smob_tag
,
1105 ppscm_print_pretty_printer_worker_smob
);
1107 gdbscm_define_functions (pretty_printer_functions
, 1);
1109 pretty_printer_list
= SCM_EOL
;
1111 pp_type_error_symbol
= scm_from_latin1_symbol ("gdb:pp-type-error");
1113 ppscm_map_string
= scm_from_latin1_string ("map");
1114 ppscm_array_string
= scm_from_latin1_string ("array");
1115 ppscm_string_string
= scm_from_latin1_string ("string");