Merge commit '60617d819d77a1b92ed6c557a0b49b8e9a8e97b9'

Conflicts:
	libguile/continuations.c
	libguile/eval.c
	libguile/goops.c
	libguile/instructions.c

9 files changed, 135 insertions, 102 deletions

diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 11a0cb1ee..e247aa7af 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -67,24 +67,30 @@ boot_print_exception (SCM port, SCM frame, SCM key, SCM args)
 }
 #undef FUNC_NAME
 
+static SCM print_exception_var;
+
+static void
+init_print_exception_var (void)
+{
+  print_exception_var
+    = scm_module_variable (scm_the_root_module (),
+                           scm_from_latin1_symbol ("print-exception"));
+}
+
 SCM
 scm_print_exception (SCM port, SCM frame, SCM key, SCM args)
 #define FUNC_NAME "print-exception"
 {
-  static SCM print_exception = SCM_BOOL_F;
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_print_exception_var);
 
   SCM_VALIDATE_OPOUTPORT (1, port);
   if (scm_is_true (frame))
     SCM_VALIDATE_FRAME (2, frame);
   SCM_VALIDATE_SYMBOL (3, key);
   SCM_VALIDATE_LIST (4, args);
-  
-  if (scm_is_false (print_exception))
-    print_exception =
-      scm_module_variable (scm_the_root_module (),
-                           scm_from_latin1_symbol ("print-exception"));
 
-  return scm_call_4 (scm_variable_ref (print_exception),
+  return scm_call_4 (scm_variable_ref (print_exception_var),
                      port, frame, key, args);
 }
 #undef FUNC_NAME
diff --git a/libguile/debug.c b/libguile/debug.c
index 9e63f2c67..f9bcc33db 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -160,19 +160,21 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 #undef FUNC_NAME
 #endif
 
+static SCM local_eval_var;
+
+static void
+init_local_eval_var (void)
+{
+  local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval");
+}
+
 SCM
 scm_local_eval (SCM exp, SCM env)
 {
-  static SCM local_eval_var = SCM_UNDEFINED;
-  static scm_i_pthread_mutex_t local_eval_var_mutex
-    = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-  scm_i_scm_pthread_mutex_lock (&local_eval_var_mutex);
-  if (SCM_UNBNDP (local_eval_var))
-    local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval");
-  scm_i_pthread_mutex_unlock (&local_eval_var_mutex);
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_local_eval_var);
 
-  return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
+  return scm_call_2 (scm_variable_ref (local_eval_var), exp, env);
 }
 
 static void
diff --git a/libguile/eval.c b/libguile/eval.c
index 3e828a178..39e66c5d7 100644
--- 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
@@ -620,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)));
 }
 
diff --git a/libguile/frames.c b/libguile/frames.c
index b0f451f7d..a651694bb 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -131,20 +131,26 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM frame_arguments_var;
+
+static void
+init_frame_arguments_var (void)
+{
+  frame_arguments_var
+    = scm_c_private_lookup ("system vm frame", "frame-arguments");
+}
+
 SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0,
 	    (SCM frame),
 	    "")
 #define FUNC_NAME s_scm_frame_arguments
 {
-  static SCM var = SCM_BOOL_F;
-  
-  SCM_VALIDATE_VM_FRAME (1, frame);
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_frame_arguments_var);
 
-  if (scm_is_false (var))
-    var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
-                               "frame-arguments");
+  SCM_VALIDATE_VM_FRAME (1, frame);
 
-  return scm_call_1 (SCM_VARIABLE_REF (var), frame);
+  return scm_call_1 (scm_variable_ref (frame_arguments_var), frame);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/goops.c b/libguile/goops.c
index 013a65c14..2cf343f79 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -1711,16 +1711,24 @@ SCM_KEYWORD (k_name, "name");
 
 SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
 
-
 SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
+
+static SCM delayed_compile_var;
+
+static void
+init_delayed_compile_var (void)
+{
+  delayed_compile_var
+    = scm_c_private_lookup ("oop goops dispatch", "delayed-compile");
+}
+
 static SCM
 make_dispatch_procedure (SCM gf)
 {
-  static SCM var = SCM_BOOL_F;
-  if (scm_is_false (var))
-    var = scm_module_variable (scm_c_resolve_module ("oop goops dispatch"),
-                               sym_delayed_compile);
-  return scm_call_1 (SCM_VARIABLE_REF (var), gf);
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_delayed_compile_var);
+
+  return scm_call_1 (scm_variable_ref (delayed_compile_var), gf);
 }
 
 static void
diff --git a/libguile/ports.c b/libguile/ports.c
index c53b7c1f9..e256d65b8 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -435,19 +435,22 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM current_warning_port_var;
+static scm_i_pthread_once_t current_warning_port_once = SCM_I_PTHREAD_ONCE_INIT;
+
+static void
+init_current_warning_port_var (void)
+{
+  current_warning_port_var
+    = scm_c_private_variable ("guile", "current-warning-port");
+}
+
 SCM
 scm_current_warning_port (void)
 {
-  static SCM cwp_var = SCM_UNDEFINED;
-  static scm_i_pthread_mutex_t cwp_var_mutex
-    = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-  scm_i_scm_pthread_mutex_lock (&cwp_var_mutex);
-  if (SCM_UNBNDP (cwp_var))
-    cwp_var = scm_c_private_variable ("guile", "current-warning-port");
-  scm_i_pthread_mutex_unlock (&cwp_var_mutex);
-  
-  return scm_call_0 (scm_variable_ref (cwp_var));
+  scm_i_pthread_once (&current_warning_port_once,
+                      init_current_warning_port_var);
+  return scm_call_0 (scm_variable_ref (current_warning_port_var));
 }
 
 SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
@@ -508,12 +511,9 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
 SCM
 scm_set_current_warning_port (SCM port)
 {
-  static SCM cwp_var = SCM_BOOL_F;
-
-  if (scm_is_false (cwp_var))
-    cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
-  
-  return scm_call_1 (scm_variable_ref (cwp_var), port);
+  scm_i_pthread_once (&current_warning_port_once,
+                      init_current_warning_port_var);
+  return scm_call_1 (scm_variable_ref (current_warning_port_var), port);
 }
 
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 1f492bd0c..e8eb91cbd 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -280,6 +280,15 @@ scm_i_print_stringbuf (SCM exp, SCM port, scm_print_state *pstate)
 
 SCM scm_nullstr;
 
+static SCM null_stringbuf;
+
+static void
+init_null_stringbuf (void)
+{
+  null_stringbuf = make_stringbuf (0);
+  SET_STRINGBUF_SHARED (null_stringbuf);
+}
+
 /* Create a scheme string with space for LEN 8-bit Latin-1-encoded
    characters.  CHARSP, if not NULL, will be set to location of the
    char array.  If READ_ONLY_P, the returned string is read-only;
@@ -287,17 +296,13 @@ SCM scm_nullstr;
 SCM
 scm_i_make_string (size_t len, char **charsp, int read_only_p)
 {
-  static SCM null_stringbuf = SCM_BOOL_F;
   SCM buf;
   SCM res;
 
   if (len == 0)
     {
-      if (SCM_UNLIKELY (scm_is_false (null_stringbuf)))
-        {
-          null_stringbuf = make_stringbuf (0);
-          SET_STRINGBUF_SHARED (null_stringbuf);
-        }
+      static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+      scm_i_pthread_once (&once, init_null_stringbuf);
       buf = null_stringbuf;
     }
   else
diff --git a/libguile/strports.c b/libguile/strports.c
index 591089477..dd3bc59d4 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -456,6 +456,16 @@ scm_c_eval_string_in_module (const char *expr, SCM module)
 }
 
 
+static SCM eval_string_var;
+static SCM k_module;
+
+static void
+init_eval_string_var_and_k_module (void)
+{
+  eval_string_var = scm_c_public_variable ("ice-9 eval-string", "eval-string");
+  k_module = scm_from_locale_keyword ("module");
+}
+
 SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, 
             (SCM string, SCM module),
 	    "Evaluate @var{string} as the text representation of a Scheme\n"
@@ -467,23 +477,16 @@ SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0,
             "procedure returns.")
 #define FUNC_NAME s_scm_eval_string_in_module
 {
-  static SCM eval_string = SCM_UNDEFINED, k_module = SCM_UNDEFINED;
-  static scm_i_pthread_mutex_t init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-  scm_i_scm_pthread_mutex_lock (&init_mutex);
-  if (SCM_UNBNDP (eval_string))
-    {
-      eval_string = scm_c_public_variable ("ice-9 eval-string", "eval-string");
-      k_module = scm_from_locale_keyword ("module");
-    }
-  scm_i_pthread_mutex_unlock (&init_mutex);
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_eval_string_var_and_k_module);
   
   if (SCM_UNBNDP (module))
     module = scm_current_module ();
   else
     SCM_VALIDATE_MODULE (2, module);
 
-  return scm_call_3 (scm_variable_ref (eval_string), string, k_module, module);
+  return scm_call_3 (scm_variable_ref (eval_string_var),
+                     string, k_module, module);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/throw.c b/libguile/throw.c
index 244bcf153..e10695a0a 100644
--- 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 ();                                                       \
-    }
-
 
 
+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);
 }
 
 
@@ -552,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"
 }