1 /* GDB/Scheme pretty-printing.
3 Copyright (C) 2008-2015 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
;
386 if (!ppscm_is_pretty_printer (matcher
))
388 return ppscm_make_pp_type_error_exception
389 (_("pretty-printer list contains non-pretty-printer object"),
393 pp_smob
= (pretty_printer_smob
*) SCM_SMOB_DATA (matcher
);
395 /* Skip if disabled. */
396 if (gdbscm_is_false (pp_smob
->enabled
))
399 if (!gdbscm_is_procedure (pp_smob
->lookup
))
401 return ppscm_make_pp_type_error_exception
402 (_("invalid lookup object in pretty-printer matcher"),
406 worker
= gdbscm_safe_call_2 (pp_smob
->lookup
, matcher
,
407 value
, gdbscm_memory_error_p
);
408 if (!gdbscm_is_false (worker
))
410 if (gdbscm_is_exception (worker
))
412 if (ppscm_is_pretty_printer_worker (worker
))
414 return ppscm_make_pp_type_error_exception
415 (_("invalid result from pretty-printer lookup"), worker
);
419 if (!scm_is_null (list
))
421 return ppscm_make_pp_type_error_exception
422 (_("pretty-printer list is not a list"), orig_list
);
428 /* Subroutine of find_pretty_printer to simplify it.
429 Look for a pretty-printer to print VALUE in all objfiles.
430 If there's an error an exception smob is returned.
431 The result is #f, if no pretty-printer was found.
432 Otherwise the result is the pretty-printer smob. */
435 ppscm_find_pretty_printer_from_objfiles (SCM value
)
437 struct objfile
*objfile
;
439 ALL_OBJFILES (objfile
)
441 objfile_smob
*o_smob
= ofscm_objfile_smob_from_objfile (objfile
);
442 SCM pp
= ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob
),
445 /* Note: This will return if pp is a <gdb:exception> object,
446 which is what we want. */
447 if (gdbscm_is_true (pp
))
454 /* Subroutine of find_pretty_printer to simplify it.
455 Look for a pretty-printer to print VALUE in the current program space.
456 If there's an error an exception smob is returned.
457 The result is #f, if no pretty-printer was found.
458 Otherwise the result is the pretty-printer smob. */
461 ppscm_find_pretty_printer_from_progspace (SCM value
)
463 pspace_smob
*p_smob
= psscm_pspace_smob_from_pspace (current_program_space
);
465 = ppscm_search_pp_list (psscm_pspace_smob_pretty_printers (p_smob
), value
);
470 /* Subroutine of find_pretty_printer to simplify it.
471 Look for a pretty-printer to print VALUE in the gdb module.
472 If there's an error a Scheme exception is returned.
473 The result is #f, if no pretty-printer was found.
474 Otherwise the result is the pretty-printer smob. */
477 ppscm_find_pretty_printer_from_gdb (SCM value
)
479 SCM pp
= ppscm_search_pp_list (pretty_printer_list
, value
);
484 /* Find the pretty-printing constructor function for VALUE. If no
485 pretty-printer exists, return #f. If one exists, return the
486 gdb:pretty-printer smob that implements it. On error, an exception smob
489 Note: In the end it may be better to call out to Scheme once, and then
490 do all of the lookup from Scheme. TBD. */
493 ppscm_find_pretty_printer (SCM value
)
497 /* Look at the pretty-printer list for each objfile
498 in the current program-space. */
499 pp
= ppscm_find_pretty_printer_from_objfiles (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 for the current program-space. */
506 pp
= ppscm_find_pretty_printer_from_progspace (value
);
507 /* Note: This will return if function is a <gdb:exception> object,
508 which is what we want. */
509 if (gdbscm_is_true (pp
))
512 /* Look at the pretty-printer list in the gdb module. */
513 pp
= ppscm_find_pretty_printer_from_gdb (value
);
517 /* Pretty-print a single value, via the PRINTER, which must be a
518 <gdb:pretty-printer-worker> object.
519 The caller is responsible for ensuring PRINTER is valid.
520 If the function returns a string, an SCM containing the string
521 is returned. If the function returns #f that means the pretty
522 printer returned #f as a value. Otherwise, if the function returns a
523 <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
524 It is an error if the printer returns #t.
525 On error, an exception smob is returned. */
528 ppscm_pretty_print_one_value (SCM printer
, struct value
**out_value
,
529 struct gdbarch
*gdbarch
,
530 const struct language_defn
*language
)
532 volatile struct gdb_exception except
;
533 SCM result
= SCM_BOOL_F
;
536 TRY_CATCH (except
, RETURN_MASK_ALL
)
539 pretty_printer_worker_smob
*w_smob
540 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
542 result
= gdbscm_safe_call_1 (w_smob
->to_string
, printer
,
543 gdbscm_memory_error_p
);
544 if (gdbscm_is_false (result
))
546 else if (scm_is_string (result
)
547 || lsscm_is_lazy_string (result
))
549 else if (vlscm_is_value (result
))
554 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
557 if (*out_value
!= NULL
)
562 else if (gdbscm_is_exception (result
))
566 /* Invalid result from to-string. */
567 result
= ppscm_make_pp_type_error_exception
568 (_("invalid result from pretty-printer to-string"), result
);
575 /* Return the display hint for PRINTER as a Scheme object.
576 The caller is responsible for ensuring PRINTER is a
577 <gdb:pretty-printer-worker> object. */
580 ppscm_get_display_hint_scm (SCM printer
)
582 pretty_printer_worker_smob
*w_smob
583 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
585 return w_smob
->display_hint
;
588 /* Return the display hint for the pretty-printer PRINTER.
589 The caller is responsible for ensuring PRINTER is a
590 <gdb:pretty-printer-worker> object.
591 Returns the display hint or #f if the hint is not a string. */
593 static enum display_hint
594 ppscm_get_display_hint_enum (SCM printer
)
596 SCM hint
= ppscm_get_display_hint_scm (printer
);
598 if (gdbscm_is_false (hint
))
600 if (scm_is_string (hint
))
602 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_array_string
)))
604 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_map_string
)))
606 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_string_string
)))
613 /* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
614 EXCEPTION is a <gdb:exception> object. */
617 ppscm_print_exception_unless_memory_error (SCM exception
,
618 struct ui_file
*stream
)
620 if (gdbscm_memory_error_p (gdbscm_exception_key (exception
)))
622 char *msg
= gdbscm_exception_message_to_string (exception
);
623 struct cleanup
*cleanup
= make_cleanup (xfree
, msg
);
625 /* This "shouldn't happen", but play it safe. */
626 if (msg
== NULL
|| *msg
== '\0')
627 fprintf_filtered (stream
, _("<error reading variable>"));
630 /* Remove the trailing newline. We could instead call a special
631 routine for printing memory error messages, but this is easy
633 size_t len
= strlen (msg
);
635 if (msg
[len
- 1] == '\n')
637 fprintf_filtered (stream
, _("<error reading variable: %s>"), msg
);
640 do_cleanups (cleanup
);
643 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
646 /* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
647 formats the result. */
649 static enum string_repr_result
650 ppscm_print_string_repr (SCM printer
, enum display_hint hint
,
651 struct ui_file
*stream
, int recurse
,
652 const struct value_print_options
*options
,
653 struct gdbarch
*gdbarch
,
654 const struct language_defn
*language
)
656 struct value
*replacement
= NULL
;
658 enum string_repr_result result
= STRING_REPR_ERROR
;
660 str_scm
= ppscm_pretty_print_one_value (printer
, &replacement
,
662 if (gdbscm_is_false (str_scm
))
664 result
= STRING_REPR_NONE
;
666 else if (scm_is_eq (str_scm
, SCM_BOOL_T
))
668 struct value_print_options opts
= *options
;
670 gdb_assert (replacement
!= NULL
);
671 opts
.addressprint
= 0;
672 common_val_print (replacement
, stream
, recurse
, &opts
, language
);
673 result
= STRING_REPR_OK
;
675 else if (scm_is_string (str_scm
))
677 struct cleanup
*cleanup
;
680 = gdbscm_scm_to_string (str_scm
, &length
,
681 target_charset (gdbarch
), 0 /*!strict*/, NULL
);
683 cleanup
= make_cleanup (xfree
, string
);
684 if (hint
== HINT_STRING
)
686 struct type
*type
= builtin_type (gdbarch
)->builtin_char
;
688 LA_PRINT_STRING (stream
, type
, (gdb_byte
*) string
,
689 length
, NULL
, 0, options
);
693 /* Alas scm_to_stringn doesn't nul-terminate the string if we
694 ask for the length. */
697 for (i
= 0; i
< length
; ++i
)
699 if (string
[i
] == '\0')
700 fputs_filtered ("\\000", stream
);
702 fputc_filtered (string
[i
], stream
);
705 result
= STRING_REPR_OK
;
706 do_cleanups (cleanup
);
708 else if (lsscm_is_lazy_string (str_scm
))
710 struct value_print_options local_opts
= *options
;
712 local_opts
.addressprint
= 0;
713 lsscm_val_print_lazy_string (str_scm
, stream
, &local_opts
);
714 result
= STRING_REPR_OK
;
718 gdb_assert (gdbscm_is_exception (str_scm
));
719 ppscm_print_exception_unless_memory_error (str_scm
, stream
);
720 result
= STRING_REPR_ERROR
;
726 /* Helper for gdbscm_apply_val_pretty_printer that formats children of the
727 printer, if any exist.
728 The caller is responsible for ensuring PRINTER is a printer smob.
729 If PRINTED_NOTHING is true, then nothing has been printed by to_string,
730 and format output accordingly. */
733 ppscm_print_children (SCM printer
, enum display_hint hint
,
734 struct ui_file
*stream
, int recurse
,
735 const struct value_print_options
*options
,
736 struct gdbarch
*gdbarch
,
737 const struct language_defn
*language
,
740 pretty_printer_worker_smob
*w_smob
741 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
742 int is_map
, is_array
, done_flag
, pretty
;
744 SCM children
, status
;
745 SCM iter
= SCM_BOOL_F
; /* -Wall */
746 struct cleanup
*cleanups
;
748 if (gdbscm_is_false (w_smob
->children
))
750 if (!gdbscm_is_procedure (w_smob
->children
))
752 ppscm_print_pp_type_error
753 (_("pretty-printer \"children\" object is not a procedure or #f"),
758 cleanups
= make_cleanup (null_cleanup
, NULL
);
760 /* If we are printing a map or an array, we want special formatting. */
761 is_map
= hint
== HINT_MAP
;
762 is_array
= hint
== HINT_ARRAY
;
764 children
= gdbscm_safe_call_1 (w_smob
->children
, printer
,
765 gdbscm_memory_error_p
);
766 if (gdbscm_is_exception (children
))
768 ppscm_print_exception_unless_memory_error (children
, stream
);
771 /* We combine two steps here: get children, make an iterator out of them.
772 This simplifies things because there's no language means of creating
773 iterators, and it's the printer object that knows how it will want its
774 children iterated over. */
775 if (!itscm_is_iterator (children
))
777 ppscm_print_pp_type_error
778 (_("result of pretty-printer \"children\" procedure is not"
779 " a <gdb:iterator> object"), children
);
784 /* Use the prettyformat_arrays option if we are printing an array,
785 and the pretty option otherwise. */
787 pretty
= options
->prettyformat_arrays
;
790 if (options
->prettyformat
== Val_prettyformat
)
793 pretty
= options
->prettyformat_structs
;
797 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
,
957 struct type
*type
, const gdb_byte
*valaddr
,
958 int embedded_offset
, CORE_ADDR address
,
959 struct ui_file
*stream
, int recurse
,
960 const struct value
*val
,
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 int result
= EXT_LANG_RC_NOP
;
972 enum string_repr_result print_result
;
974 /* No pretty-printer support for unavailable values. */
975 if (!value_bytes_available (val
, embedded_offset
, TYPE_LENGTH (type
)))
976 return EXT_LANG_RC_NOP
;
978 if (!gdb_scheme_initialized
)
979 return EXT_LANG_RC_NOP
;
981 cleanups
= make_cleanup (null_cleanup
, NULL
);
983 /* Instantiate the printer. */
985 valaddr
+= embedded_offset
;
986 value
= value_from_contents_and_address (type
, valaddr
,
987 address
+ embedded_offset
);
989 set_value_component_location (value
, val
);
990 /* set_value_component_location resets the address, so we may
991 need to set it again. */
992 if (VALUE_LVAL (value
) != lval_internalvar
993 && VALUE_LVAL (value
) != lval_internalvar_component
994 && VALUE_LVAL (value
) != lval_computed
)
995 set_value_address (value
, address
+ embedded_offset
);
997 val_obj
= vlscm_scm_from_value (value
);
998 if (gdbscm_is_exception (val_obj
))
1000 exception
= val_obj
;
1001 result
= EXT_LANG_RC_ERROR
;
1005 printer
= ppscm_find_pretty_printer (val_obj
);
1007 if (gdbscm_is_exception (printer
))
1009 exception
= printer
;
1010 result
= EXT_LANG_RC_ERROR
;
1013 if (gdbscm_is_false (printer
))
1015 result
= EXT_LANG_RC_NOP
;
1018 gdb_assert (ppscm_is_pretty_printer_worker (printer
));
1020 /* If we are printing a map, we want some special formatting. */
1021 hint
= ppscm_get_display_hint_enum (printer
);
1022 if (hint
== HINT_ERROR
)
1024 /* Print the error as an exception for consistency. */
1025 SCM hint_scm
= ppscm_get_display_hint_scm (printer
);
1027 ppscm_print_pp_type_error ("Invalid display hint", hint_scm
);
1028 /* Fall through. A bad hint doesn't stop pretty-printing. */
1032 /* Print the section. */
1033 print_result
= ppscm_print_string_repr (printer
, hint
, stream
, recurse
,
1034 options
, gdbarch
, language
);
1035 if (print_result
!= STRING_REPR_ERROR
)
1037 ppscm_print_children (printer
, hint
, stream
, recurse
, options
,
1039 print_result
== STRING_REPR_NONE
);
1042 result
= EXT_LANG_RC_OK
;
1045 if (gdbscm_is_exception (exception
))
1046 ppscm_print_exception_unless_memory_error (exception
, stream
);
1047 do_cleanups (cleanups
);
1051 /* Initialize the Scheme pretty-printer code. */
1053 static const scheme_function pretty_printer_functions
[] =
1055 { "make-pretty-printer", 2, 0, 0, gdbscm_make_pretty_printer
,
1057 Create a <gdb:pretty-printer> object.\n\
1059 Arguments: name lookup\n\
1060 name: a string naming the matcher\n\
1061 lookup: a procedure:\n\
1062 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1064 { "pretty-printer?", 1, 0, 0, gdbscm_pretty_printer_p
,
1066 Return #t if the object is a <gdb:pretty-printer> object." },
1068 { "pretty-printer-enabled?", 1, 0, 0, gdbscm_pretty_printer_enabled_p
,
1070 Return #t if the pretty-printer is enabled." },
1072 { "set-pretty-printer-enabled!", 2, 0, 0,
1073 gdbscm_set_pretty_printer_enabled_x
,
1075 Set the enabled flag of the pretty-printer.\n\
1076 Returns \"unspecified\"." },
1078 { "make-pretty-printer-worker", 3, 0, 0, gdbscm_make_pretty_printer_worker
,
1080 Create a <gdb:pretty-printer-worker> object.\n\
1082 Arguments: display-hint to-string children\n\
1083 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1084 to-string: a procedure:\n\
1085 (pretty-printer) -> string | #f | <gdb:value>\n\
1086 children: either #f or a procedure:\n\
1087 (pretty-printer) -> <gdb:iterator>" },
1089 { "pretty-printer-worker?", 1, 0, 0, gdbscm_pretty_printer_worker_p
,
1091 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1093 { "pretty-printers", 0, 0, 0, gdbscm_pretty_printers
,
1095 Return the list of global pretty-printers." },
1097 { "set-pretty-printers!", 1, 0, 0,
1098 gdbscm_set_pretty_printers_x
,
1100 Set the list of global pretty-printers." },
1106 gdbscm_initialize_pretty_printers (void)
1108 pretty_printer_smob_tag
1109 = gdbscm_make_smob_type (pretty_printer_smob_name
,
1110 sizeof (pretty_printer_smob
));
1111 scm_set_smob_print (pretty_printer_smob_tag
,
1112 ppscm_print_pretty_printer_smob
);
1114 pretty_printer_worker_smob_tag
1115 = gdbscm_make_smob_type (pretty_printer_worker_smob_name
,
1116 sizeof (pretty_printer_worker_smob
));
1117 scm_set_smob_print (pretty_printer_worker_smob_tag
,
1118 ppscm_print_pretty_printer_worker_smob
);
1120 gdbscm_define_functions (pretty_printer_functions
, 1);
1122 pretty_printer_list
= SCM_EOL
;
1124 pp_type_error_symbol
= scm_from_latin1_symbol ("gdb:pp-type-error");
1126 ppscm_map_string
= scm_from_latin1_string ("map");
1127 ppscm_array_string
= scm_from_latin1_string ("array");
1128 ppscm_string_string
= scm_from_latin1_string ("string");