diff options
-rw-r--r-- | libguile/control.c | 19 | ||||
-rw-r--r-- | libguile/control.h | 3 | ||||
-rw-r--r-- | libguile/init.c | 2 |
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 (); |