summaryrefslogtreecommitdiff
path: root/libguile/backtrace.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-02-11 13:13:26 +0100
committerAndy Wingo <wingo@pobox.com>2011-02-11 13:13:26 +0100
commite8df456a152ded4f0d7189f0770e3b08cd41674e (patch)
tree1a2b19fb6e2fa8eddbe8211042187db39b395786 /libguile/backtrace.c
parenteaba53b7c8156547a6eeca0385c88121a9f4b55d (diff)
downloadguile-e8df456a152ded4f0d7189f0770e3b08cd41674e.tar.gz
print-exception gets a c binding
* libguile/backtrace.c (scm_print_exception): Add C binding for print-exception, which dispatches to whatever is defined in Scheme. (boot_print_exception): Add initial binding, replaced later in Scheme. * module/ice-9/boot-9.scm: Expect there to already be a print-exception binding.
Diffstat (limited to 'libguile/backtrace.c')
-rw-r--r--libguile/backtrace.c38
1 files changed, 38 insertions, 0 deletions
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 7e93ff3f5..70bb7fba9 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -55,6 +55,42 @@
* Note that these functions shouldn't generate errors themselves.
*/
+static SCM
+boot_print_exception (SCM port, SCM frame, SCM key, SCM args)
+#define FUNC_NAME "boot-print-exception"
+{
+ scm_puts ("Throw to key ", port);
+ scm_write (key, port);
+ scm_puts (" with args ", port);
+ scm_write (args, port);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM
+scm_print_exception (SCM port, SCM frame, SCM key, SCM args)
+#define FUNC_NAME "print-exception"
+{
+ static SCM print_exception = SCM_BOOL_F;
+
+ SCM_VALIDATE_OPOUTPORT (1, port);
+ if (scm_is_true (frame))
+ SCM_VALIDATE_FRAME (2, frame);
+ SCM_VALIDATE_SYMBOL (3, key);
+ SCM_VALIDATE_LIST (4, args);
+
+ if (scm_is_false (print_exception))
+ print_exception = scm_c_module_lookup (scm_the_root_module (),
+ "print-exception");
+
+ return scm_call_4 (scm_variable_ref (print_exception),
+ port, frame, key, args);
+}
+#undef FUNC_NAME
+
+
+
+
/* Print parameters for error messages. */
#define DISPLAY_ERROR_MESSAGE_MAX_LEVEL 7
@@ -72,6 +108,7 @@
if (!(_cond)) \
return SCM_BOOL_F;
+
static void
display_header (SCM source, SCM port)
{
@@ -734,6 +771,7 @@ scm_backtrace (void)
void
scm_init_backtrace ()
{
+ scm_c_define_gsubr ("print-exception", 4, 0, 0, boot_print_exception);
#include "libguile/backtrace.x"
}