Merge commit '60617d819d77a1b92ed6c557a0b49b8e9a8e97b9'

[bpt/guile.git] / libguile / throw.c

diff --git a/libguile/throw.c b/libguile/throw.c
index de157fa..e10695a 100644 (file)
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -53,24 +53,14 @@
    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
@@ -80,28 +70,32 @@ scm_catch_with_pre_unwind_handler (SCM key, SCM thunk, SCM handler,
   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
@@ -442,7 +436,7 @@ scm_handle_by_throw (void *handler_data SCM_UNUSED, SCM tag, SCM args)
 }
 
 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);
 }
@@ -456,7 +450,8 @@ 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)
 {
-  volatile SCM vm, v_handler;
+  struct scm_vm *vp;
+  volatile SCM v_handler;
   SCM res;
   scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
   scm_i_jmp_buf registers;
@@ -469,22 +464,26 @@ pre_init_catch (SCM tag, SCM thunk, SCM handler, SCM pre_unwind_handler)
 
   /* These two are volatile, so we know we can access them after a
      nonlocal return to the setjmp.  */
-  vm = scm_the_vm ();
+  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_ESCAPE_ONLY
+                            | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
                             sym_pre_init_catch_tag,
-                            SCM_VM_DATA (vm)->fp,
-                            SCM_VM_DATA (vm)->sp,
-                            SCM_VM_DATA (vm)->ip,
+                            vp->fp - vp->stack_base,
+                            vp->sp - vp->stack_base,
+                            vp->ip,
                             &registers);
 
   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 (v_handler, scm_cdr (args));
     }
@@ -547,8 +546,10 @@ scm_init_throw ()
   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"
 }