summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/control.c19
-rw-r--r--libguile/control.h3
-rw-r--r--libguile/init.c2
3 files changed, 19 insertions, 5 deletions
diff --git a/libguile/control.c b/libguile/control.c
index 49a19cf44..05a8dab1e 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -28,6 +28,9 @@
+SCM scm_sys_default_prompt_tag;
+
+
SCM
scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
scm_t_int64 vm_cookie)
@@ -193,9 +196,13 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie)
any code that might throw up. */
if (scm_is_false (prompt))
{
- /* FIXME: jump to default */
- /* scm_handle_by_message (NULL, key, args); */
- abort ();
+ if (scm_is_eq (tag, scm_fluid_ref (scm_sys_default_prompt_tag)))
+ {
+ fprintf (stderr, "No prompt found for abort to default prompt tag!\n");
+ abort ();
+ }
+ else
+ scm_misc_error ("abort", "abort to unknown tag", scm_list_1 (tag));
}
cont = reify_partial_continuation (vm, prompt, winds, cookie);
@@ -250,9 +257,13 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM args),
}
#undef FUNC_NAME
-void scm_init_control (void)
+void
+scm_init_control (void)
{
#include "control.x"
+ scm_sys_default_prompt_tag = scm_make_fluid ();
+ scm_fluid_set_x (scm_sys_default_prompt_tag, scm_gensym (SCM_UNDEFINED));
+ scm_c_define ("%default-prompt-tag", scm_sys_default_prompt_tag);
}
/*
diff --git a/libguile/control.h b/libguile/control.h
index 160728d8f..146e216bd 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -42,6 +42,9 @@ struct scm_prompt_registers
};
+SCM_INTERNAL SCM scm_sys_default_prompt_tag;
+
+
SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
scm_t_int64 cookie);
SCM_INTERNAL SCM scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
diff --git a/libguile/init.c b/libguile/init.c
index e72b9460f..9879cb300 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -470,7 +470,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_async (); /* requires smob_prehistory */
scm_init_boolean ();
scm_init_chars ();
- scm_init_control ();
#ifdef GUILE_DEBUG_MALLOC
scm_init_debug_malloc ();
#endif
@@ -478,6 +477,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_eq ();
scm_init_error ();
scm_init_fluids ();
+ scm_init_control (); /* requires fluids */
scm_init_feature ();
scm_init_backtrace ();
scm_init_fports ();