Merge commit '60617d819d77a1b92ed6c557a0b49b8e9a8e97b9'

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

diff --git a/libguile/eval.c b/libguile/eval.c
index 7b09d84..39e66c5 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,
- *   2005,2006,2007,2008,2009,2010,2011,2012,2013
+ *   2005,2006,2007,2008,2009,2010,2011,2012,2013,2014
  * Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -334,7 +334,7 @@ eval (SCM x, SCM env)
          for (i = 0; i < argc; i++, mx = CDR (mx))
            argv[i] = EVAL1 (CAR (mx), env);
 
-         return scm_c_vm_run (scm_the_vm (), proc, argv, argc);
+         return scm_call_n (proc, argv, argc);
         }
 
     case SCM_M_CONT:
@@ -438,7 +438,8 @@ eval (SCM x, SCM env)
 
     case SCM_M_CALL_WITH_PROMPT:
       {
-        SCM vm, k, res;
+        struct scm_vm *vp;
+        SCM k, res;
         scm_i_jmp_buf registers;
         /* We need the handler after nonlocal return to the setjmp, so
            make sure it is volatile.  */
@@ -446,23 +447,24 @@ eval (SCM x, SCM env)
 
         k = EVAL1 (CAR (mx), env);
         handler = EVAL1 (CDDR (mx), env);
-        vm = scm_the_vm ();
+        vp = scm_the_vm ();
 
         /* Push the prompt onto the dynamic stack. */
-        scm_dynstack_push_prompt
-          (&SCM_I_CURRENT_THREAD->dynstack,
-           SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
-           k,
-           SCM_VM_DATA (vm)->fp - SCM_VM_DATA (vm)->stack_base,
-           SCM_VM_DATA (vm)->sp - SCM_VM_DATA (vm)->stack_base,
-           SCM_VM_DATA (vm)->ip,
-           &registers);
+        scm_dynstack_push_prompt (&SCM_I_CURRENT_THREAD->dynstack,
+                                  SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
+                                  | SCM_F_DYNSTACK_PROMPT_PUSH_NARGS,
+                                  k,
+                                  vp->fp - vp->stack_base,
+                                  vp->sp - vp->stack_base,
+                                  vp->ip,
+                                  &registers);
 
         if (SCM_I_SETJMP (registers))
           {
             /* The prompt exited nonlocally. */
             proc = handler;
-            args = scm_i_prompt_pop_abort_args_x (scm_the_vm ());
+            vp = scm_the_vm ();
+            args = scm_i_prompt_pop_abort_args_x (vp);
             goto apply_proc;
           }
         
@@ -484,41 +486,41 @@ eval (SCM x, SCM env)
 SCM
 scm_call_0 (SCM proc)
 {
-  return scm_c_vm_run (scm_the_vm (), proc, NULL, 0);
+  return scm_call_n (proc, NULL, 0);
 }
 
 SCM
 scm_call_1 (SCM proc, SCM arg1)
 {
-  return scm_c_vm_run (scm_the_vm (), proc, &arg1, 1);
+  return scm_call_n (proc, &arg1, 1);
 }
 
 SCM
 scm_call_2 (SCM proc, SCM arg1, SCM arg2)
 {
   SCM args[] = { arg1, arg2 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 2);
+  return scm_call_n (proc, args, 2);
 }
 
 SCM
 scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
 {
   SCM args[] = { arg1, arg2, arg3 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 3);
+  return scm_call_n (proc, args, 3);
 }
 
 SCM
 scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4)
 {
   SCM args[] = { arg1, arg2, arg3, arg4 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 4);
+  return scm_call_n (proc, args, 4);
 }
 
 SCM
 scm_call_5 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5)
 {
   SCM args[] = { arg1, arg2, arg3, arg4, arg5 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 5);
+  return scm_call_n (proc, args, 5);
 }
 
 SCM
@@ -526,7 +528,7 @@ scm_call_6 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5,
             SCM arg6)
 {
   SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 6);
+  return scm_call_n (proc, args, 6);
 }
 
 SCM
@@ -534,7 +536,7 @@ scm_call_7 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5,
             SCM arg6, SCM arg7)
 {
   SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 7);
+  return scm_call_n (proc, args, 7);
 }
 
 SCM
@@ -542,7 +544,7 @@ scm_call_8 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5,
             SCM arg6, SCM arg7, SCM arg8)
 {
   SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 8);
+  return scm_call_n (proc, args, 8);
 }
 
 SCM
@@ -550,14 +552,10 @@ scm_call_9 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4, SCM arg5,
             SCM arg6, SCM arg7, SCM arg8, SCM arg9)
 {
   SCM args[] = { arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9 };
-  return scm_c_vm_run (scm_the_vm (), proc, args, 9);
+  return scm_call_n (proc, args, 9);
 }
 
-SCM
-scm_call_n (SCM proc, SCM *argv, size_t nargs)
-{
-  return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
-}
+/* scm_call_n defined in vm.c */
 
 SCM
 scm_call (SCM proc, ...)
@@ -577,7 +575,7 @@ scm_call (SCM proc, ...)
     argv[i] = va_arg (argp, SCM);
   va_end (argp);
 
-  return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
+  return scm_call_n (proc, argv, nargs);
 }
 
 /* Simple procedure applies
@@ -601,7 +599,7 @@ scm_apply_0 (SCM proc, SCM args)
       args = SCM_CDR (args);
     }
 
-  return scm_c_vm_run (scm_the_vm (), proc, argv, nargs);
+  return scm_call_n (proc, argv, nargs);
 }
 
 SCM
@@ -622,30 +620,37 @@ scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args)
   return scm_apply_0 (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args)));
 }
 
+static SCM map_var, for_each_var;
+
+static void init_map_var (void)
+{
+  map_var = scm_private_variable (scm_the_root_module (),
+                                  scm_from_latin1_symbol ("map"));
+}
+
+static void init_for_each_var (void)
+{
+  for_each_var = scm_private_variable (scm_the_root_module (),
+                                       scm_from_latin1_symbol ("for-each"));
+}
 
 SCM 
 scm_map (SCM proc, SCM arg1, SCM args)
 {
-  static SCM var = SCM_BOOL_F;
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_map_var);
 
-  if (scm_is_false (var))
-    var = scm_private_variable (scm_the_root_module (),
-                                scm_from_latin1_symbol ("map"));
-
-  return scm_apply_0 (scm_variable_ref (var),
+  return scm_apply_0 (scm_variable_ref (map_var),
                       scm_cons (proc, scm_cons (arg1, args)));
 }
 
 SCM 
 scm_for_each (SCM proc, SCM arg1, SCM args)
 {
-  static SCM var = SCM_BOOL_F;
-
-  if (scm_is_false (var))
-    var = scm_private_variable (scm_the_root_module (),
-                                scm_from_latin1_symbol ("for-each"));
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_for_each_var);
 
-  return scm_apply_0 (scm_variable_ref (var),
+  return scm_apply_0 (scm_variable_ref (for_each_var),
                       scm_cons (proc, scm_cons (arg1, args)));
 }
 
@@ -662,8 +667,8 @@ static SCM var_primitive_eval;
 SCM
 scm_primitive_eval (SCM exp)
 {
-  return scm_c_vm_run (scm_the_vm (), scm_variable_ref (var_primitive_eval),
-                       &exp, 1);
+  return scm_call_n (scm_variable_ref (var_primitive_eval),
+                     &exp, 1);
 }