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 char *msg
= xstrprintf ("%s: ~S", message
);
331 struct cleanup
*cleanup
= make_cleanup (xfree
, msg
);
333 = gdbscm_make_error (pp_type_error_symbol
,
334 NULL
/* func */, msg
,
335 scm_list_1 (object
), scm_list_1 (object
));
337 do_cleanups (cleanup
);
342 /* Print MESSAGE as an exception (meaning it is controlled by
343 "guile print-stack").
344 Called from the printer code when the Scheme code returns an invalid type
348 ppscm_print_pp_type_error (const char *message
, SCM object
)
350 SCM exception
= ppscm_make_pp_type_error_exception (message
, object
);
352 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
355 /* Helper function for find_pretty_printer which iterates over a list,
356 calls each function and inspects output. This will return a
357 <gdb:pretty-printer> object if one recognizes VALUE. If no printer is
358 found, it will return #f. On error, it will return a <gdb:exception>
361 Note: This has to be efficient and careful.
362 We don't want to excessively slow down printing of values, but any kind of
363 random crud can appear in the pretty-printer list, and we can't crash
367 ppscm_search_pp_list (SCM list
, SCM value
)
369 SCM orig_list
= list
;
371 if (scm_is_null (list
))
373 if (gdbscm_is_false (scm_list_p (list
))) /* scm_is_pair? */
375 return ppscm_make_pp_type_error_exception
376 (_("pretty-printer list is not a list"), list
);
379 for ( ; scm_is_pair (list
); list
= scm_cdr (list
))
381 SCM matcher
= scm_car (list
);
383 pretty_printer_smob
*pp_smob
;
385 if (!ppscm_is_pretty_printer (matcher
))
387 return ppscm_make_pp_type_error_exception
388 (_("pretty-printer list contains non-pretty-printer object"),
392 pp_smob
= (pretty_printer_smob
*) SCM_SMOB_DATA (matcher
);
394 /* Skip if disabled. */
395 if (gdbscm_is_false (pp_smob
->enabled
))
398 if (!gdbscm_is_procedure (pp_smob
->lookup
))
400 return ppscm_make_pp_type_error_exception
401 (_("invalid lookup object in pretty-printer matcher"),
405 worker
= gdbscm_safe_call_2 (pp_smob
->lookup
, matcher
,
406 value
, gdbscm_memory_error_p
);
407 if (!gdbscm_is_false (worker
))
409 if (gdbscm_is_exception (worker
))
411 if (ppscm_is_pretty_printer_worker (worker
))
413 return ppscm_make_pp_type_error_exception
414 (_("invalid result from pretty-printer lookup"), worker
);
418 if (!scm_is_null (list
))
420 return ppscm_make_pp_type_error_exception
421 (_("pretty-printer list is not a list"), orig_list
);
427 /* Subroutine of find_pretty_printer to simplify it.
428 Look for a pretty-printer to print VALUE in all objfiles.
429 If there's an error an exception smob is returned.
430 The result is #f, if no pretty-printer was found.
431 Otherwise the result is the pretty-printer smob. */
434 ppscm_find_pretty_printer_from_objfiles (SCM value
)
436 struct objfile
*objfile
;
438 ALL_OBJFILES (objfile
)
440 objfile_smob
*o_smob
= ofscm_objfile_smob_from_objfile (objfile
);
441 SCM pp
= ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob
),
444 /* Note: This will return if pp is a <gdb:exception> object,
445 which is what we want. */
446 if (gdbscm_is_true (pp
))
453 /* Subroutine of find_pretty_printer to simplify it.
454 Look for a pretty-printer to print VALUE in the current program space.
455 If there's an error an exception smob is returned.
456 The result is #f, if no pretty-printer was found.
457 Otherwise the result is the pretty-printer smob. */
460 ppscm_find_pretty_printer_from_progspace (SCM value
)
462 pspace_smob
*p_smob
= psscm_pspace_smob_from_pspace (current_program_space
);
464 = ppscm_search_pp_list (psscm_pspace_smob_pretty_printers (p_smob
), value
);
469 /* Subroutine of find_pretty_printer to simplify it.
470 Look for a pretty-printer to print VALUE in the gdb module.
471 If there's an error a Scheme exception is returned.
472 The result is #f, if no pretty-printer was found.
473 Otherwise the result is the pretty-printer smob. */
476 ppscm_find_pretty_printer_from_gdb (SCM value
)
478 SCM pp
= ppscm_search_pp_list (pretty_printer_list
, value
);
483 /* Find the pretty-printing constructor function for VALUE. If no
484 pretty-printer exists, return #f. If one exists, return the
485 gdb:pretty-printer smob that implements it. On error, an exception smob
488 Note: In the end it may be better to call out to Scheme once, and then
489 do all of the lookup from Scheme. TBD. */
492 ppscm_find_pretty_printer (SCM value
)
496 /* Look at the pretty-printer list for each objfile
497 in the current program-space. */
498 pp
= ppscm_find_pretty_printer_from_objfiles (value
);
499 /* Note: This will return if function is a <gdb:exception> object,
500 which is what we want. */
501 if (gdbscm_is_true (pp
))
504 /* Look at the pretty-printer list for the current program-space. */
505 pp
= ppscm_find_pretty_printer_from_progspace (value
);
506 /* Note: This will return if function is a <gdb:exception> object,
507 which is what we want. */
508 if (gdbscm_is_true (pp
))
511 /* Look at the pretty-printer list in the gdb module. */
512 pp
= ppscm_find_pretty_printer_from_gdb (value
);
516 /* Pretty-print a single value, via the PRINTER, which must be a
517 <gdb:pretty-printer-worker> object.
518 The caller is responsible for ensuring PRINTER is valid.
519 If the function returns a string, an SCM containing the string
520 is returned. If the function returns #f that means the pretty
521 printer returned #f as a value. Otherwise, if the function returns a
522 <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
523 It is an error if the printer returns #t.
524 On error, an exception smob is returned. */
527 ppscm_pretty_print_one_value (SCM printer
, struct value
**out_value
,
528 struct gdbarch
*gdbarch
,
529 const struct language_defn
*language
)
531 SCM result
= SCM_BOOL_F
;
536 pretty_printer_worker_smob
*w_smob
537 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
539 result
= gdbscm_safe_call_1 (w_smob
->to_string
, printer
,
540 gdbscm_memory_error_p
);
541 if (gdbscm_is_false (result
))
543 else if (scm_is_string (result
)
544 || lsscm_is_lazy_string (result
))
546 else if (vlscm_is_value (result
))
551 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
554 if (*out_value
!= NULL
)
559 else if (gdbscm_is_exception (result
))
563 /* Invalid result from to-string. */
564 result
= ppscm_make_pp_type_error_exception
565 (_("invalid result from pretty-printer to-string"), result
);
568 CATCH (except
, RETURN_MASK_ALL
)
576 /* Return the display hint for PRINTER as a Scheme object.
577 The caller is responsible for ensuring PRINTER is a
578 <gdb:pretty-printer-worker> object. */
581 ppscm_get_display_hint_scm (SCM printer
)
583 pretty_printer_worker_smob
*w_smob
584 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
586 return w_smob
->display_hint
;
589 /* Return the display hint for the pretty-printer PRINTER.
590 The caller is responsible for ensuring PRINTER is a
591 <gdb:pretty-printer-worker> object.
592 Returns the display hint or #f if the hint is not a string. */
594 static enum display_hint
595 ppscm_get_display_hint_enum (SCM printer
)
597 SCM hint
= ppscm_get_display_hint_scm (printer
);
599 if (gdbscm_is_false (hint
))
601 if (scm_is_string (hint
))
603 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_array_string
)))
605 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_map_string
)))
607 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_string_string
)))
614 /* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
615 EXCEPTION is a <gdb:exception> object. */
618 ppscm_print_exception_unless_memory_error (SCM exception
,
619 struct ui_file
*stream
)
621 if (gdbscm_memory_error_p (gdbscm_exception_key (exception
)))
623 char *msg
= gdbscm_exception_message_to_string (exception
);
624 struct cleanup
*cleanup
= make_cleanup (xfree
, msg
);
626 /* This "shouldn't happen", but play it safe. */
627 if (msg
== NULL
|| *msg
== '\0')
628 fprintf_filtered (stream
, _("<error reading variable>"));
631 /* Remove the trailing newline. We could instead call a special
632 routine for printing memory error messages, but this is easy
634 size_t len
= strlen (msg
);
636 if (msg
[len
- 1] == '\n')
638 fprintf_filtered (stream
, _("<error reading variable: %s>"), msg
);
641 do_cleanups (cleanup
);
644 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
647 /* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
648 formats the result. */
650 static enum string_repr_result
651 ppscm_print_string_repr (SCM printer
, enum display_hint hint
,
652 struct ui_file
*stream
, int recurse
,
653 const struct value_print_options
*options
,
654 struct gdbarch
*gdbarch
,
655 const struct language_defn
*language
)
657 struct value
*replacement
= NULL
;
659 enum string_repr_result result
= STRING_REPR_ERROR
;
661 str_scm
= ppscm_pretty_print_one_value (printer
, &replacement
,
663 if (gdbscm_is_false (str_scm
))
665 result
= STRING_REPR_NONE
;
667 else if (scm_is_eq (str_scm
, SCM_BOOL_T
))
669 struct value_print_options opts
= *options
;
671 gdb_assert (replacement
!= NULL
);
672 opts
.addressprint
= 0;
673 common_val_print (replacement
, stream
, recurse
, &opts
, language
);
674 result
= STRING_REPR_OK
;
676 else if (scm_is_string (str_scm
))
678 struct cleanup
*cleanup
;
681 = gdbscm_scm_to_string (str_scm
, &length
,
682 target_charset (gdbarch
), 0 /*!strict*/, NULL
);
684 cleanup
= make_cleanup (xfree
, string
);
685 if (hint
== HINT_STRING
)
687 struct type
*type
= builtin_type (gdbarch
)->builtin_char
;
689 LA_PRINT_STRING (stream
, type
, (gdb_byte
*) string
,
690 length
, NULL
, 0, options
);
694 /* Alas scm_to_stringn doesn't nul-terminate the string if we
695 ask for the length. */
698 for (i
= 0; i
< length
; ++i
)
700 if (string
[i
] == '\0')
701 fputs_filtered ("\\000", stream
);
703 fputc_filtered (string
[i
], stream
);
706 result
= STRING_REPR_OK
;
707 do_cleanups (cleanup
);
709 else if (lsscm_is_lazy_string (str_scm
))
711 struct value_print_options local_opts
= *options
;
713 local_opts
.addressprint
= 0;
714 lsscm_val_print_lazy_string (str_scm
, stream
, &local_opts
);
715 result
= STRING_REPR_OK
;
719 gdb_assert (gdbscm_is_exception (str_scm
));
720 ppscm_print_exception_unless_memory_error (str_scm
, stream
);
721 result
= STRING_REPR_ERROR
;
727 /* Helper for gdbscm_apply_val_pretty_printer that formats children of the
728 printer, if any exist.
729 The caller is responsible for ensuring PRINTER is a printer smob.
730 If PRINTED_NOTHING is true, then nothing has been printed by to_string,
731 and format output accordingly. */
734 ppscm_print_children (SCM printer
, enum display_hint hint
,
735 struct ui_file
*stream
, int recurse
,
736 const struct value_print_options
*options
,
737 struct gdbarch
*gdbarch
,
738 const struct language_defn
*language
,
741 pretty_printer_worker_smob
*w_smob
742 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
743 int is_map
, is_array
, done_flag
, pretty
;
746 SCM iter
= SCM_BOOL_F
; /* -Wall */
747 struct cleanup
*cleanups
;
749 if (gdbscm_is_false (w_smob
->children
))
751 if (!gdbscm_is_procedure (w_smob
->children
))
753 ppscm_print_pp_type_error
754 (_("pretty-printer \"children\" object is not a procedure or #f"),
759 cleanups
= make_cleanup (null_cleanup
, NULL
);
761 /* If we are printing a map or an array, we want special formatting. */
762 is_map
= hint
== HINT_MAP
;
763 is_array
= hint
== HINT_ARRAY
;
765 children
= gdbscm_safe_call_1 (w_smob
->children
, printer
,
766 gdbscm_memory_error_p
);
767 if (gdbscm_is_exception (children
))
769 ppscm_print_exception_unless_memory_error (children
, stream
);
772 /* We combine two steps here: get children, make an iterator out of them.
773 This simplifies things because there's no language means of creating
774 iterators, and it's the printer object that knows how it will want its
775 children iterated over. */
776 if (!itscm_is_iterator (children
))
778 ppscm_print_pp_type_error
779 (_("result of pretty-printer \"children\" procedure is not"
780 " a <gdb:iterator> object"), children
);
785 /* Use the prettyformat_arrays option if we are printing an array,
786 and the pretty option otherwise. */
788 pretty
= options
->prettyformat_arrays
;
791 if (options
->prettyformat
== Val_prettyformat
)
794 pretty
= options
->prettyformat_structs
;
798 for (i
= 0; i
< options
->print_max
; ++i
)
802 SCM item
= itscm_safe_call_next_x (iter
, gdbscm_memory_error_p
);
803 struct cleanup
*inner_cleanup
= make_cleanup (null_cleanup
, NULL
);
805 if (gdbscm_is_exception (item
))
807 ppscm_print_exception_unless_memory_error (item
, stream
);
810 if (itscm_is_end_of_iteration (item
))
812 /* Set a flag so we can know whether we printed all the
813 available elements. */
818 if (! scm_is_pair (item
))
820 ppscm_print_pp_type_error
821 (_("result of pretty-printer children iterator is not a pair"
822 " or (end-of-iteration)"),
826 scm_name
= scm_car (item
);
827 v_scm
= scm_cdr (item
);
828 if (!scm_is_string (scm_name
))
830 ppscm_print_pp_type_error
831 (_("first element of pretty-printer children iterator is not"
835 name
= gdbscm_scm_to_c_string (scm_name
);
836 make_cleanup (xfree
, name
);
838 /* Print initial "{". For other elements, there are three cases:
839 1. Maps. Print a "," after each value element.
840 2. Arrays. Always print a ",".
841 3. Other. Always print a ",". */
845 fputs_filtered ("{", stream
);
847 fputs_filtered (" = {", stream
);
850 else if (! is_map
|| i
% 2 == 0)
851 fputs_filtered (pretty
? "," : ", ", stream
);
853 /* In summary mode, we just want to print "= {...}" if there is
855 if (options
->summary
)
857 /* This increment tricks the post-loop logic to print what
865 if (! is_map
|| i
% 2 == 0)
869 fputs_filtered ("\n", stream
);
870 print_spaces_filtered (2 + 2 * recurse
, stream
);
873 wrap_here (n_spaces (2 + 2 *recurse
));
876 if (is_map
&& i
% 2 == 0)
877 fputs_filtered ("[", stream
);
880 /* We print the index, not whatever the child method
881 returned as the name. */
882 if (options
->print_array_indexes
)
883 fprintf_filtered (stream
, "[%d] = ", i
);
887 fputs_filtered (name
, stream
);
888 fputs_filtered (" = ", stream
);
891 if (lsscm_is_lazy_string (v_scm
))
893 struct value_print_options local_opts
= *options
;
895 local_opts
.addressprint
= 0;
896 lsscm_val_print_lazy_string (v_scm
, stream
, &local_opts
);
898 else if (scm_is_string (v_scm
))
900 char *output
= gdbscm_scm_to_c_string (v_scm
);
902 fputs_filtered (output
, stream
);
909 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
915 ppscm_print_exception_unless_memory_error (except_scm
, stream
);
918 common_val_print (value
, stream
, recurse
+ 1, options
, language
);
921 if (is_map
&& i
% 2 == 0)
922 fputs_filtered ("] = ", stream
);
924 do_cleanups (inner_cleanup
);
933 fputs_filtered ("\n", stream
);
934 print_spaces_filtered (2 + 2 * recurse
, stream
);
936 fputs_filtered ("...", stream
);
940 fputs_filtered ("\n", stream
);
941 print_spaces_filtered (2 * recurse
, stream
);
943 fputs_filtered ("}", stream
);
947 do_cleanups (cleanups
);
949 /* Play it safe, make sure ITER doesn't get GC'd. */
950 scm_remember_upto_here_1 (iter
);
953 /* This is the extension_language_ops.apply_val_pretty_printer "method". */
956 gdbscm_apply_val_pretty_printer (const struct extension_language_defn
*extlang
,
958 LONGEST embedded_offset
, CORE_ADDR address
,
959 struct ui_file
*stream
, int recurse
,
961 const struct value_print_options
*options
,
962 const struct language_defn
*language
)
964 struct gdbarch
*gdbarch
= get_type_arch (type
);
965 SCM exception
= SCM_BOOL_F
;
966 SCM printer
= SCM_BOOL_F
;
967 SCM val_obj
= SCM_BOOL_F
;
969 enum display_hint hint
;
970 struct cleanup
*cleanups
;
971 enum ext_lang_rc result
= EXT_LANG_RC_NOP
;
972 enum string_repr_result print_result
;
973 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
975 /* No pretty-printer support for unavailable values. */
976 if (!value_bytes_available (val
, embedded_offset
, TYPE_LENGTH (type
)))
977 return EXT_LANG_RC_NOP
;
979 if (!gdb_scheme_initialized
)
980 return EXT_LANG_RC_NOP
;
982 cleanups
= make_cleanup (null_cleanup
, NULL
);
984 /* Instantiate the printer. */
985 value
= value_from_component (val
, type
, embedded_offset
);
987 val_obj
= vlscm_scm_from_value (value
);
988 if (gdbscm_is_exception (val_obj
))
991 result
= EXT_LANG_RC_ERROR
;
995 printer
= ppscm_find_pretty_printer (val_obj
);
997 if (gdbscm_is_exception (printer
))
1000 result
= EXT_LANG_RC_ERROR
;
1003 if (gdbscm_is_false (printer
))
1005 result
= EXT_LANG_RC_NOP
;
1008 gdb_assert (ppscm_is_pretty_printer_worker (printer
));
1010 /* If we are printing a map, we want some special formatting. */
1011 hint
= ppscm_get_display_hint_enum (printer
);
1012 if (hint
== HINT_ERROR
)
1014 /* Print the error as an exception for consistency. */
1015 SCM hint_scm
= ppscm_get_display_hint_scm (printer
);
1017 ppscm_print_pp_type_error ("Invalid display hint", hint_scm
);
1018 /* Fall through. A bad hint doesn't stop pretty-printing. */
1022 /* Print the section. */
1023 print_result
= ppscm_print_string_repr (printer
, hint
, stream
, recurse
,
1024 options
, gdbarch
, language
);
1025 if (print_result
!= STRING_REPR_ERROR
)
1027 ppscm_print_children (printer
, hint
, stream
, recurse
, options
,
1029 print_result
== STRING_REPR_NONE
);
1032 result
= EXT_LANG_RC_OK
;
1035 if (gdbscm_is_exception (exception
))
1036 ppscm_print_exception_unless_memory_error (exception
, stream
);
1037 do_cleanups (cleanups
);
1041 /* Initialize the Scheme pretty-printer code. */
1043 static const scheme_function pretty_printer_functions
[] =
1045 { "make-pretty-printer", 2, 0, 0,
1046 as_a_scm_t_subr (gdbscm_make_pretty_printer
),
1048 Create a <gdb:pretty-printer> object.\n\
1050 Arguments: name lookup\n\
1051 name: a string naming the matcher\n\
1052 lookup: a procedure:\n\
1053 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1055 { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p
),
1057 Return #t if the object is a <gdb:pretty-printer> object." },
1059 { "pretty-printer-enabled?", 1, 0, 0,
1060 as_a_scm_t_subr (gdbscm_pretty_printer_enabled_p
),
1062 Return #t if the pretty-printer is enabled." },
1064 { "set-pretty-printer-enabled!", 2, 0, 0,
1065 as_a_scm_t_subr (gdbscm_set_pretty_printer_enabled_x
),
1067 Set the enabled flag of the pretty-printer.\n\
1068 Returns \"unspecified\"." },
1070 { "make-pretty-printer-worker", 3, 0, 0,
1071 as_a_scm_t_subr (gdbscm_make_pretty_printer_worker
),
1073 Create a <gdb:pretty-printer-worker> object.\n\
1075 Arguments: display-hint to-string children\n\
1076 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1077 to-string: a procedure:\n\
1078 (pretty-printer) -> string | #f | <gdb:value>\n\
1079 children: either #f or a procedure:\n\
1080 (pretty-printer) -> <gdb:iterator>" },
1082 { "pretty-printer-worker?", 1, 0, 0,
1083 as_a_scm_t_subr (gdbscm_pretty_printer_worker_p
),
1085 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1087 { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers
),
1089 Return the list of global pretty-printers." },
1091 { "set-pretty-printers!", 1, 0, 0,
1092 as_a_scm_t_subr (gdbscm_set_pretty_printers_x
),
1094 Set the list of global pretty-printers." },
1100 gdbscm_initialize_pretty_printers (void)
1102 pretty_printer_smob_tag
1103 = gdbscm_make_smob_type (pretty_printer_smob_name
,
1104 sizeof (pretty_printer_smob
));
1105 scm_set_smob_print (pretty_printer_smob_tag
,
1106 ppscm_print_pretty_printer_smob
);
1108 pretty_printer_worker_smob_tag
1109 = gdbscm_make_smob_type (pretty_printer_worker_smob_name
,
1110 sizeof (pretty_printer_worker_smob
));
1111 scm_set_smob_print (pretty_printer_worker_smob_tag
,
1112 ppscm_print_pretty_printer_worker_smob
);
1114 gdbscm_define_functions (pretty_printer_functions
, 1);
1116 pretty_printer_list
= SCM_EOL
;
1118 pp_type_error_symbol
= scm_from_latin1_symbol ("gdb:pp-type-error");
1120 ppscm_map_string
= scm_from_latin1_string ("map");
1121 ppscm_array_string
= scm_from_latin1_string ("array");
1122 ppscm_string_string
= scm_from_latin1_string ("string");