-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
baggage. */
-#define CACHE_VAR(var,name) \
- static SCM var = SCM_BOOL_F; \
- if (scm_is_false (var)) \
- { \
- var = scm_module_variable (scm_the_root_module (), \
- scm_from_latin1_symbol (name)); \
- if (scm_is_false (var)) \
- abort (); \
- }
-
\f
+static SCM catch_var, throw_var, with_throw_handler_var;
+
SCM
scm_catch (SCM key, SCM thunk, SCM handler)
{
- CACHE_VAR (var, "catch");
-
- return scm_call_3 (scm_variable_ref (var), key, thunk, handler);
+ return scm_call_3 (scm_variable_ref (catch_var), key, thunk, handler);
}
SCM
if (SCM_UNBNDP (pre_unwind_handler))
return scm_catch (key, thunk, handler);
else
- {
- CACHE_VAR (var, "catch");
-
- return scm_call_4 (scm_variable_ref (var), key, thunk, handler,
- pre_unwind_handler);
- }
+ return scm_call_4 (scm_variable_ref (catch_var), key, thunk, handler,
+ pre_unwind_handler);
+}
+
+static void
+init_with_throw_handler_var (void)
+{
+ with_throw_handler_var
+ = scm_module_variable (scm_the_root_module (),
+ scm_from_latin1_symbol ("with-throw-handler"));
}
SCM
scm_with_throw_handler (SCM key, SCM thunk, SCM handler)
{
- CACHE_VAR (var, "with-throw-handler");
+ static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+ scm_i_pthread_once (&once, init_with_throw_handler_var);
- return scm_call_3 (scm_variable_ref (var), key, thunk, handler);
+ return scm_call_3 (scm_variable_ref (with_throw_handler_var),
+ key, thunk, handler);
}
SCM
scm_throw (SCM key, SCM args)
{
- CACHE_VAR (var, "throw");
-
- return scm_apply_1 (scm_variable_ref (var), key, args);
+ return scm_apply_1 (scm_variable_ref (throw_var), key, args);
}
\f
}
SCM
-scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
+scm_ithrow (SCM key, SCM args, int no_return SCM_UNUSED)
{
return scm_throw (key, args);
}
static SCM
pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
{
- SCM vm, prompt, res;
+ struct scm_vm *vp;
+ volatile SCM v_handler;
+ SCM res;
+ scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
+ scm_i_jmp_buf registers;
/* Only handle catch-alls without pre-unwind handlers */
if (!SCM_UNBNDP (pre_unwind_handler))
if (scm_is_false (scm_eqv_p (tag, SCM_BOOL_T)))
abort ();
- vm = scm_the_vm ();
- 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)));
-
- if (SCM_PROMPT_SETJMP (prompt))
+ /* These two are volatile, so we know we can access them after a
+ nonlocal return to the setjmp. */
+ vp = scm_the_vm ();
+ v_handler = handler;
+
+ /* Push the prompt onto the dynamic stack. */
+ scm_dynstack_push_prompt (dynstack,
+ SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
+ | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
+ sym_pre_init_catch_tag,
+ vp->fp - vp->stack_base,
+ vp->sp - vp->stack_base,
+ vp->ip,
+ ®isters);
+
+ if (SCM_I_SETJMP (registers))
{
/* nonlocal exit */
- SCM args = scm_i_prompt_pop_abort_args_x (vm);
+ SCM args;
+ /* vp is not volatile */
+ vp = scm_the_vm ();
+ args = scm_i_prompt_pop_abort_args_x (vp);
/* cdr past the continuation */
- return scm_apply_0 (handler, scm_cdr (args));
+ return scm_apply_0 (v_handler, scm_cdr (args));
}
res = scm_call_0 (thunk);
- scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+ scm_dynstack_pop (dynstack);
return res;
}
static int
find_pre_init_catch (void)
{
- SCM winds;
-
- /* Search the wind list for an appropriate prompt.
- "Waiter, please bring us the wind list." */
- for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = SCM_CDR (winds))
- if (SCM_PROMPT_P (SCM_CAR (winds))
- && scm_is_eq (SCM_PROMPT_TAG (SCM_CAR (winds)), sym_pre_init_catch_tag))
- return 1;
+ if (scm_dynstack_find_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+ sym_pre_init_catch_tag,
+ NULL, NULL, NULL, NULL, NULL))
+ return 1;
return 0;
}
pre_init_throw (SCM k, SCM args)
{
if (find_pre_init_catch ())
- return scm_at_abort (sym_pre_init_catch_tag, scm_cons (k, args));
+ return scm_abort_to_prompt_star (sym_pre_init_catch_tag, scm_cons (k, args));
else
{
static int error_printing_error = 0;
tc16_catch_closure = scm_make_smob_type ("catch-closure", 0);
scm_set_smob_apply (tc16_catch_closure, apply_catch_closure, 0, 0, 1);
- scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0, pre_init_catch));
- scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1, pre_init_throw));
+ catch_var = scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0,
+ pre_init_catch));
+ throw_var = scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1,
+ pre_init_throw));
#include "libguile/throw.x"
}
HCoop / bpt / guile.git / blobdiff