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
))
672 gdb::unique_xmalloc_ptr
<char> string
673 = gdbscm_scm_to_string (str_scm
, &length
,
674 target_charset (gdbarch
), 0 /*!strict*/, NULL
);
676 if (hint
== HINT_STRING
)
678 struct type
*type
= builtin_type (gdbarch
)->builtin_char
;
680 LA_PRINT_STRING (stream
, type
, (gdb_byte
*) string
.get (),
681 length
, NULL
, 0, options
);
685 /* Alas scm_to_stringn doesn't nul-terminate the string if we
686 ask for the length. */
689 for (i
= 0; i
< length
; ++i
)
691 if (string
.get ()[i
] == '\0')
692 fputs_filtered ("\\000", stream
);
694 fputc_filtered (string
.get ()[i
], stream
);
697 result
= STRING_REPR_OK
;
699 else if (lsscm_is_lazy_string (str_scm
))
701 struct value_print_options local_opts
= *options
;
703 local_opts
.addressprint
= 0;
704 lsscm_val_print_lazy_string (str_scm
, stream
, &local_opts
);
705 result
= STRING_REPR_OK
;
709 gdb_assert (gdbscm_is_exception (str_scm
));
710 ppscm_print_exception_unless_memory_error (str_scm
, stream
);
711 result
= STRING_REPR_ERROR
;
717 /* Helper for gdbscm_apply_val_pretty_printer that formats children of the
718 printer, if any exist.
719 The caller is responsible for ensuring PRINTER is a printer smob.
720 If PRINTED_NOTHING is true, then nothing has been printed by to_string,
721 and format output accordingly. */
724 ppscm_print_children (SCM printer
, enum display_hint hint
,
725 struct ui_file
*stream
, int recurse
,
726 const struct value_print_options
*options
,
727 struct gdbarch
*gdbarch
,
728 const struct language_defn
*language
,
731 pretty_printer_worker_smob
*w_smob
732 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
733 int is_map
, is_array
, done_flag
, pretty
;
736 SCM iter
= SCM_BOOL_F
; /* -Wall */
737 struct cleanup
*cleanups
;
739 if (gdbscm_is_false (w_smob
->children
))
741 if (!gdbscm_is_procedure (w_smob
->children
))
743 ppscm_print_pp_type_error
744 (_("pretty-printer \"children\" object is not a procedure or #f"),
749 cleanups
= make_cleanup (null_cleanup
, NULL
);
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
;
755 children
= gdbscm_safe_call_1 (w_smob
->children
, printer
,
756 gdbscm_memory_error_p
);
757 if (gdbscm_is_exception (children
))
759 ppscm_print_exception_unless_memory_error (children
, stream
);
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
))
768 ppscm_print_pp_type_error
769 (_("result of pretty-printer \"children\" procedure is not"
770 " a <gdb:iterator> object"), children
);
775 /* Use the prettyformat_arrays option if we are printing an array,
776 and the pretty option otherwise. */
778 pretty
= options
->prettyformat_arrays
;
781 if (options
->prettyformat
== Val_prettyformat
)
784 pretty
= options
->prettyformat_structs
;
788 for (i
= 0; i
< options
->print_max
; ++i
)
792 SCM item
= itscm_safe_call_next_x (iter
, gdbscm_memory_error_p
);
793 struct cleanup
*inner_cleanup
= make_cleanup (null_cleanup
, NULL
);
795 if (gdbscm_is_exception (item
))
797 ppscm_print_exception_unless_memory_error (item
, stream
);
800 if (itscm_is_end_of_iteration (item
))
802 /* Set a flag so we can know whether we printed all the
803 available elements. */
808 if (! scm_is_pair (item
))
810 ppscm_print_pp_type_error
811 (_("result of pretty-printer children iterator is not a pair"
812 " or (end-of-iteration)"),
816 scm_name
= scm_car (item
);
817 v_scm
= scm_cdr (item
);
818 if (!scm_is_string (scm_name
))
820 ppscm_print_pp_type_error
821 (_("first element of pretty-printer children iterator is not"
825 name
= gdbscm_scm_to_c_string (scm_name
);
826 make_cleanup (xfree
, name
);
828 /* Print initial "{". For other elements, there are three cases:
829 1. Maps. Print a "," after each value element.
830 2. Arrays. Always print a ",".
831 3. Other. Always print a ",". */
835 fputs_filtered ("{", stream
);
837 fputs_filtered (" = {", stream
);
840 else if (! is_map
|| i
% 2 == 0)
841 fputs_filtered (pretty
? "," : ", ", stream
);
843 /* In summary mode, we just want to print "= {...}" if there is
845 if (options
->summary
)
847 /* This increment tricks the post-loop logic to print what
855 if (! is_map
|| i
% 2 == 0)
859 fputs_filtered ("\n", stream
);
860 print_spaces_filtered (2 + 2 * recurse
, stream
);
863 wrap_here (n_spaces (2 + 2 *recurse
));
866 if (is_map
&& i
% 2 == 0)
867 fputs_filtered ("[", stream
);
870 /* We print the index, not whatever the child method
871 returned as the name. */
872 if (options
->print_array_indexes
)
873 fprintf_filtered (stream
, "[%d] = ", i
);
877 fputs_filtered (name
, stream
);
878 fputs_filtered (" = ", stream
);
881 if (lsscm_is_lazy_string (v_scm
))
883 struct value_print_options local_opts
= *options
;
885 local_opts
.addressprint
= 0;
886 lsscm_val_print_lazy_string (v_scm
, stream
, &local_opts
);
888 else if (scm_is_string (v_scm
))
890 char *output
= gdbscm_scm_to_c_string (v_scm
);
892 fputs_filtered (output
, stream
);
899 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
905 ppscm_print_exception_unless_memory_error (except_scm
, stream
);
908 common_val_print (value
, stream
, recurse
+ 1, options
, language
);
911 if (is_map
&& i
% 2 == 0)
912 fputs_filtered ("] = ", stream
);
914 do_cleanups (inner_cleanup
);
923 fputs_filtered ("\n", stream
);
924 print_spaces_filtered (2 + 2 * recurse
, stream
);
926 fputs_filtered ("...", stream
);
930 fputs_filtered ("\n", stream
);
931 print_spaces_filtered (2 * recurse
, stream
);
933 fputs_filtered ("}", stream
);
937 do_cleanups (cleanups
);
939 /* Play it safe, make sure ITER doesn't get GC'd. */
940 scm_remember_upto_here_1 (iter
);
943 /* This is the extension_language_ops.apply_val_pretty_printer "method". */
946 gdbscm_apply_val_pretty_printer (const struct extension_language_defn
*extlang
,
948 LONGEST embedded_offset
, CORE_ADDR address
,
949 struct ui_file
*stream
, int recurse
,
951 const struct value_print_options
*options
,
952 const struct language_defn
*language
)
954 struct gdbarch
*gdbarch
= get_type_arch (type
);
955 SCM exception
= SCM_BOOL_F
;
956 SCM printer
= SCM_BOOL_F
;
957 SCM val_obj
= SCM_BOOL_F
;
959 enum display_hint hint
;
960 struct cleanup
*cleanups
;
961 enum ext_lang_rc result
= EXT_LANG_RC_NOP
;
962 enum string_repr_result print_result
;
963 const gdb_byte
*valaddr
= value_contents_for_printing (val
);
965 /* No pretty-printer support for unavailable values. */
966 if (!value_bytes_available (val
, embedded_offset
, TYPE_LENGTH (type
)))
967 return EXT_LANG_RC_NOP
;
969 if (!gdb_scheme_initialized
)
970 return EXT_LANG_RC_NOP
;
972 cleanups
= make_cleanup (null_cleanup
, NULL
);
974 /* Instantiate the printer. */
975 value
= value_from_component (val
, type
, embedded_offset
);
977 val_obj
= vlscm_scm_from_value (value
);
978 if (gdbscm_is_exception (val_obj
))
981 result
= EXT_LANG_RC_ERROR
;
985 printer
= ppscm_find_pretty_printer (val_obj
);
987 if (gdbscm_is_exception (printer
))
990 result
= EXT_LANG_RC_ERROR
;
993 if (gdbscm_is_false (printer
))
995 result
= EXT_LANG_RC_NOP
;
998 gdb_assert (ppscm_is_pretty_printer_worker (printer
));
1000 /* If we are printing a map, we want some special formatting. */
1001 hint
= ppscm_get_display_hint_enum (printer
);
1002 if (hint
== HINT_ERROR
)
1004 /* Print the error as an exception for consistency. */
1005 SCM hint_scm
= ppscm_get_display_hint_scm (printer
);
1007 ppscm_print_pp_type_error ("Invalid display hint", hint_scm
);
1008 /* Fall through. A bad hint doesn't stop pretty-printing. */
1012 /* Print the section. */
1013 print_result
= ppscm_print_string_repr (printer
, hint
, stream
, recurse
,
1014 options
, gdbarch
, language
);
1015 if (print_result
!= STRING_REPR_ERROR
)
1017 ppscm_print_children (printer
, hint
, stream
, recurse
, options
,
1019 print_result
== STRING_REPR_NONE
);
1022 result
= EXT_LANG_RC_OK
;
1025 if (gdbscm_is_exception (exception
))
1026 ppscm_print_exception_unless_memory_error (exception
, stream
);
1027 do_cleanups (cleanups
);
1031 /* Initialize the Scheme pretty-printer code. */
1033 static const scheme_function pretty_printer_functions
[] =
1035 { "make-pretty-printer", 2, 0, 0,
1036 as_a_scm_t_subr (gdbscm_make_pretty_printer
),
1038 Create a <gdb:pretty-printer> object.\n\
1040 Arguments: name lookup\n\
1041 name: a string naming the matcher\n\
1042 lookup: a procedure:\n\
1043 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1045 { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p
),
1047 Return #t if the object is a <gdb:pretty-printer> object." },
1049 { "pretty-printer-enabled?", 1, 0, 0,
1050 as_a_scm_t_subr (gdbscm_pretty_printer_enabled_p
),
1052 Return #t if the pretty-printer is enabled." },
1054 { "set-pretty-printer-enabled!", 2, 0, 0,
1055 as_a_scm_t_subr (gdbscm_set_pretty_printer_enabled_x
),
1057 Set the enabled flag of the pretty-printer.\n\
1058 Returns \"unspecified\"." },
1060 { "make-pretty-printer-worker", 3, 0, 0,
1061 as_a_scm_t_subr (gdbscm_make_pretty_printer_worker
),
1063 Create a <gdb:pretty-printer-worker> object.\n\
1065 Arguments: display-hint to-string children\n\
1066 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1067 to-string: a procedure:\n\
1068 (pretty-printer) -> string | #f | <gdb:value>\n\
1069 children: either #f or a procedure:\n\
1070 (pretty-printer) -> <gdb:iterator>" },
1072 { "pretty-printer-worker?", 1, 0, 0,
1073 as_a_scm_t_subr (gdbscm_pretty_printer_worker_p
),
1075 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1077 { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers
),
1079 Return the list of global pretty-printers." },
1081 { "set-pretty-printers!", 1, 0, 0,
1082 as_a_scm_t_subr (gdbscm_set_pretty_printers_x
),
1084 Set the list of global pretty-printers." },
1090 gdbscm_initialize_pretty_printers (void)
1092 pretty_printer_smob_tag
1093 = gdbscm_make_smob_type (pretty_printer_smob_name
,
1094 sizeof (pretty_printer_smob
));
1095 scm_set_smob_print (pretty_printer_smob_tag
,
1096 ppscm_print_pretty_printer_smob
);
1098 pretty_printer_worker_smob_tag
1099 = gdbscm_make_smob_type (pretty_printer_worker_smob_name
,
1100 sizeof (pretty_printer_worker_smob
));
1101 scm_set_smob_print (pretty_printer_worker_smob_tag
,
1102 ppscm_print_pretty_printer_worker_smob
);
1104 gdbscm_define_functions (pretty_printer_functions
, 1);
1106 pretty_printer_list
= SCM_EOL
;
1108 pp_type_error_symbol
= scm_from_latin1_symbol ("gdb:pp-type-error");
1110 ppscm_map_string
= scm_from_latin1_string ("map");
1111 ppscm_array_string
= scm_from_latin1_string ("array");
1112 ppscm_string_string
= scm_from_latin1_string ("string");