diff options
-rw-r--r-- | libguile/control.c | 19 | ||||
-rw-r--r-- | libguile/control.h | 3 | ||||
-rw-r--r-- | libguile/throw.c | 7 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 7 |
4 files changed, 12 insertions, 24 deletions
diff --git a/libguile/control.c b/libguile/control.c index 7e51e1e38..78a325674 100644 --- a/libguile/control.c +++ b/libguile/control.c @@ -28,8 +28,6 @@ -SCM scm_sys_default_prompt_tag; - SCM scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip, @@ -207,19 +205,9 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, scm_t_int64 cookie) } } - /* If we didn't find anything, print a message and abort the process - right here. If you don't want this, establish a catch-all around - any code that might throw up. */ + /* If we didn't find anything, raise an error. */ if (scm_is_false (prompt)) - { - 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)); - } + scm_misc_error ("abort", "abort to unknown tag", scm_list_1 (tag)); cont = reify_partial_continuation (vm, prompt, winds, cookie); @@ -285,9 +273,6 @@ void scm_init_control (void) { #include "libguile/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 74a13293d..bbc4c2099 100644 --- a/libguile/control.h +++ b/libguile/control.h @@ -41,9 +41,6 @@ struct scm_prompt_registers }; -SCM_INTERNAL SCM scm_sys_default_prompt_tag; - - SCM_INTERNAL SCM scm_c_make_prompt (SCM k, SCM *fp, SCM *sp, scm_t_uint8 *abort_ip, scm_t_uint8 escape_only_p, diff --git a/libguile/throw.c b/libguile/throw.c index 04bcba83e..595e3beac 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -498,6 +498,9 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) /* Unfortunately we have to support catch and throw before boot-9 has, um, booted. So here are lame versions, which will get replaced with their scheme equivalents. */ + +SCM_SYMBOL (sym_pre_init_catch_tag, "%pre-init-catch-tag"); + static SCM pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) { @@ -510,7 +513,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) abort (); vm = scm_the_vm (); - prompt = scm_c_make_prompt (scm_fluid_ref (scm_sys_default_prompt_tag), + prompt = scm_c_make_prompt (sym_pre_init_catch_tag, SCM_VM_DATA (vm)->fp, SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->ip, 1, -1, scm_i_dynwinds ()); scm_i_set_dynwinds (scm_cons (prompt, SCM_PROMPT_DYNWINDS (prompt))); @@ -532,7 +535,7 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler) static SCM pre_init_throw (SCM args) { - return scm_at_abort (scm_fluid_ref (scm_sys_default_prompt_tag), args); + return scm_at_abort (sym_pre_init_catch_tag, args); } void diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 49127b072..5c777f498 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -48,10 +48,13 @@ ;; Define delimited continuation operators, and implement catch and throw in ;; terms of them. -(define (default-prompt-tag) - (fluid-ref %default-prompt-tag)) (define (make-prompt-tag . stem) (gensym (if (pair? stem) (car stem) "prompt"))) +(define default-prompt-tag + ;; not sure if we should expose this to the user as a fluid + (let ((%default-prompt-tag (make-prompt-tag))) + (lambda () + %default-prompt-tag))) (define (call-with-prompt tag thunk handler) (@prompt tag (thunk) handler)) |