summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/control.c19
-rw-r--r--libguile/control.h3
-rw-r--r--libguile/throw.c7
-rw-r--r--module/ice-9/boot-9.scm7
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))