[PATCH] Fix thread-unsafe lazy initializations

[PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 79 bytes --]

Here's my proposed patch to fix these problems.
What do you think?

    Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Fix thread-unsafe lazy initializations --]
[-- Type: text/x-diff, Size: 4085 bytes --]

From dadcb1512569c1be039fc75f0a2967e370939e42 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Thu, 28 Feb 2013 17:56:58 -0500
Subject: [PATCH] Fix thread-unsafe lazy initializations.

* libguile/debug.c (scm_local_eval):
  libguile/ports.c (scm_current_warning_port):
  libguile/strports.c (scm_eval_string_in_module): Perform
  lazy-initialization while holding a mutex.  Use SCM_UNDEFINED as the
  uninitialized value.  Use 'scm_c_*_variable'.

* doc/ref/api-modules.texi (Accessing Modules from C): Fix
  'my_eval_string' example to be thread-safe.
---
 doc/ref/api-modules.texi |   13 +++++++------
 libguile/debug.c         |    8 ++++++--
 libguile/ports.c         |   12 ++++++++----
 libguile/strports.c      |    9 ++++++---
 4 files changed, 27 insertions(+), 15 deletions(-)

diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi
index 17ab462..3d111c4 100644
--- a/doc/ref/api-modules.texi
+++ b/doc/ref/api-modules.texi
@@ -942,14 +942,15 @@ the @var{name} is not bound in the module, signals an error.  Returns a
 variable, always.
 
 @example
-SCM my_eval_string (SCM str)
-@{
-  static SCM eval_string_var = SCM_BOOL_F;
+static SCM eval_string_var;
 
-  if (scm_is_false (eval_string_var))
-    eval_string_var =
-      scm_c_public_lookup ("ice-9 eval-string", "eval-string");
+void my_init (void)
+@{
+  eval_string_var = scm_c_public_lookup ("ice-9 eval-string", "eval-string");
+@}
 
+SCM my_eval_string (SCM str)
+@{
   return scm_call_1 (scm_variable_ref (eval_string_var), str);
 @}
 @end example
diff --git a/libguile/debug.c b/libguile/debug.c
index b1a90d8..9e6328b 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -211,10 +211,14 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0,
 SCM
 scm_local_eval (SCM exp, SCM env)
 {
-  static SCM local_eval_var = SCM_BOOL_F;
+  static SCM local_eval_var = SCM_UNDEFINED;
+  static scm_i_pthread_mutex_t local_eval_var_mutex
+    = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
-  if (scm_is_false (local_eval_var))
+  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);
 
   return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env);
 }
diff --git a/libguile/ports.c b/libguile/ports.c
index 55808e2..8737a76 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -418,10 +418,14 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
 SCM
 scm_current_warning_port (void)
 {
-  static SCM cwp_var = SCM_BOOL_F;
-
-  if (scm_is_false (cwp_var))
-    cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
+  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));
 }
diff --git a/libguile/strports.c b/libguile/strports.c
index 14cc93f..d1b293c 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -534,13 +534,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_BOOL_F, k_module = SCM_BOOL_F;
+  static SCM eval_string = SCM_UNDEFINED, k_module = SCM_UNDEFINED;
+  static scm_i_pthread_mutex_t init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
-  if (scm_is_false (eval_string))
+  scm_i_scm_pthread_mutex_lock (&init_mutex);
+  if (SCM_UNBNDP (eval_string))
     {
-      eval_string = scm_c_public_lookup ("ice-9 eval-string", "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);
   
   if (SCM_UNBNDP (module))
     module = scm_current_module ();
-- 
1.7.10.4

Re: [PATCH] Fix thread-unsafe lazy initializations

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> From dadcb1512569c1be039fc75f0a2967e370939e42 Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> Date: Thu, 28 Feb 2013 17:56:58 -0500
> Subject: [PATCH] Fix thread-unsafe lazy initializations.
>
> * libguile/debug.c (scm_local_eval):
>   libguile/ports.c (scm_current_warning_port):
>   libguile/strports.c (scm_eval_string_in_module): Perform
>   lazy-initialization while holding a mutex.  Use SCM_UNDEFINED as the
>   uninitialized value.  Use 'scm_c_*_variable'.
>
> * doc/ref/api-modules.texi (Accessing Modules from C): Fix
>   'my_eval_string' example to be thread-safe.

Looks good to me.

> --- a/doc/ref/api-modules.texi
> +++ b/doc/ref/api-modules.texi
> @@ -942,14 +942,15 @@ the @var{name} is not bound in the module, signals an error.  Returns a
>  variable, always.
>  
>  @example
> -SCM my_eval_string (SCM str)
> -@{
> -  static SCM eval_string_var = SCM_BOOL_F;
> +static SCM eval_string_var;
>  
> -  if (scm_is_false (eval_string_var))
> -    eval_string_var =
> -      scm_c_public_lookup ("ice-9 eval-string", "eval-string");
> +void my_init (void)
> +@{
> +  eval_string_var = scm_c_public_lookup ("ice-9 eval-string", "eval-string");
> +@}
>  
> +SCM my_eval_string (SCM str)
> +@{
>    return scm_call_1 (scm_variable_ref (eval_string_var), str);
>  @}
>  @end example

The doc should say something about ‘my_init’, and perhaps mention
locking?

Ludo’.

Re: [PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

Hi Ludovic,

ludo@gnu.org (Ludovic Courtès) writes:

> Mark H Weaver <mhw@netris.org> skribis:
>
>> --- a/doc/ref/api-modules.texi
>> +++ b/doc/ref/api-modules.texi
>> @@ -942,14 +942,15 @@ the @var{name} is not bound in the module, signals an error.  Returns a
>>  variable, always.
>>  
>>  @example
>> -SCM my_eval_string (SCM str)
>> -@{
>> -  static SCM eval_string_var = SCM_BOOL_F;
>> +static SCM eval_string_var;
>>  
>> -  if (scm_is_false (eval_string_var))
>> -    eval_string_var =
>> -      scm_c_public_lookup ("ice-9 eval-string", "eval-string");
>> +void my_init (void)
>> +@{
>> +  eval_string_var = scm_c_public_lookup ("ice-9 eval-string", "eval-string");
>> +@}
>>  
>> +SCM my_eval_string (SCM str)
>> +@{
>>    return scm_call_1 (scm_variable_ref (eval_string_var), str);
>>  @}
>>  @end example
>
> The doc should say something about ‘my_init’, and perhaps mention
> locking?

Can you suggest some text?  'my_init' seems obvious to me, and given
that this is just an example for 'scm_c_*_lookup', it seems out of place
to talk about general locking issues here, but feel free to propose some
text to go here.

    Thanks,
      Mark

Re: [PATCH] Fix thread-unsafe lazy initializations

[Ludovic Courtès]

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Mark H Weaver <mhw@netris.org> skribis:
>>
>>> --- a/doc/ref/api-modules.texi
>>> +++ b/doc/ref/api-modules.texi
>>> @@ -942,14 +942,15 @@ the @var{name} is not bound in the module, signals an error.  Returns a
>>>  variable, always.
>>>  
>>>  @example
>>> -SCM my_eval_string (SCM str)
>>> -@{
>>> -  static SCM eval_string_var = SCM_BOOL_F;
>>> +static SCM eval_string_var;
>>>  
>>> -  if (scm_is_false (eval_string_var))
>>> -    eval_string_var =
>>> -      scm_c_public_lookup ("ice-9 eval-string", "eval-string");
>>> +void my_init (void)
>>> +@{
>>> +  eval_string_var = scm_c_public_lookup ("ice-9 eval-string", "eval-string");
>>> +@}
>>>  
>>> +SCM my_eval_string (SCM str)
>>> +@{
>>>    return scm_call_1 (scm_variable_ref (eval_string_var), str);
>>>  @}
>>>  @end example
>>
>> The doc should say something about ‘my_init’, and perhaps mention
>> locking?
>
> Can you suggest some text?  'my_init' seems obvious to me, and given
> that this is just an example for 'scm_c_*_lookup', it seems out of place
> to talk about general locking issues here, but feel free to propose some
> text to go here.

Agreed.  Perhaps just something like: “Note that the program should
ensure that ‘my_init’ is called only once, and in a thread-safe way.”

Ludo’.

Re: [PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

ludo@gnu.org (Ludovic Courtès) writes:
> Agreed.  Perhaps just something like: “Note that the program should
> ensure that ‘my_init’ is called only once, and in a thread-safe way.”

Okay, I went ahead and pushed it to stable-2.0, with the code comment:
"It is important that the call to 'my_init' happens-before all calls to
'my_eval_string'."

    Thanks,
      Mark

[PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 166 bytes --]

This patch fixes all of the thread-unsafe lazy initializations I could
find in stable-2.0, using 'scm_i_pthread_once'.

Any comments and/or objections?

      Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Fix thread-unsafe lazy initializations --]
[-- Type: text/x-patch, Size: 20596 bytes --]

From bf3da52963fa68b9fea90b41585f642c7aecd3d4 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Thu, 23 Jan 2014 11:37:36 -0500
Subject: [PATCH] Fix thread-unsafe lazy initializations.

* libguile/backtrace.c (print_exception_var): New static variable.
  (init_print_exception_var): New static function.
  (scm_print_exception): Remove thread-unsafe lazy initialization.
  Call 'init_print_exception_var' using 'scm_i_pthread_once'.
  Use 'print_exception_var'.

* libguile/continuations.c (call_cc): New static variable.
  (init_call_cc): New static function.
  (scm_i_call_with_current_continuation): Remove thread-unsafe lazy
  initialization.  Call 'init_call_cc' using 'scm_i_pthread_once'.

* libguile/debug.c (local_eval_var): New static variable.
  (init_local_eval_var): New static function.
  (scm_local_eval): Remove lazy initialization using mutexes.
  Call 'init_local_eval_var' using 'scm_i_pthread_once'.
  Use 'scm_variable_ref' instead of 'SCM_VARIABLE_REF'.

* libguile/eval.c (map_var, for_each_var): New static variables.
  (init_map_var, init_for_each_var): New static functions.
  (scm_map, scm_for_each): Remove thread-unsafe lazy initializations.
  Call 'init_map_var' (or 'init_for_each_var') using 'scm_i_pthread_once'.
  Use 'map_var' (or 'for_each_var').

* libguile/frames.c (frame_arguments_var): New static variable.
  (init_frame_arguments_var): New static function.
  (scm_frame_arguments): Remove thread-unsafe lazy initialization.
  Call 'init_frame_arguments_var' using 'scm_i_pthread_once'.
  Use 'frame_arguments_var'.  Use 'scm_variable_ref' instead of
  'SCM_VARIABLE_REF'.

* libguile/goops.c (delayed_compile_var): New static variable.
  (init_delayed_compile_var): New static function.
  (make_dispatch_procedure): Remove thread-unsafe lazy initialization.
  Call 'init_delayed_compile_var' using 'scm_i_pthread_once'.
  Use 'delayed_compile_var'.  Use 'scm_variable_ref' instead of
  'SCM_VARIABLE_REF'.

* libguile/instructions.c (instructions_by_name): New static variable.
  (init_instructions_by_name): New static function.
  (scm_lookup_instruction_by_name): Remove thread-unsafe lazy
  initialization.  Call 'init_instructions_by_name' using
  'scm_i_pthread_once'.

* libguile/ports.c (current_warning_port_var)
  (current_warning_port_once): New static variables.
  (init_current_warning_port_var): New static function.

  (scm_current_warning_port): Remove lazy initialization using mutexes.
  Call 'init_current_warning_port_var' using 'scm_i_pthread_once'.
  Use 'current_warning_port_var'.
  (scm_set_current_warning_port): Remove thread-unsafe lazy initialization.
  Call 'init_current_warning_port_var' using 'scm_i_pthread_once'.
  Use 'current_warning_port_var'.

* libguile/strings.c (null_stringbuf): New static variable.
  (init_null_stringbuf): New static function.
  (scm_i_make_string): Remove thread-unsafe lazy initialization.
  Call 'init_null_stringbuf' using 'scm_i_pthread_once'.

* libguile/strports.c (eval_string_var, k_module): New static variables.
  (init_eval_string_var_and_k_module): New static function.
  (scm_eval_string_in_module): Remove lazy initialization using mutexes.
  Call 'init_eval_string_var_and_k_module' using 'scm_i_pthread_once'.
  Use 'eval_string_var'.

* libguile/throw.c (CACHE_VAR): Remove incorrect macro.
  (catch_var, throw_var, with_throw_handler_var): New static variables.
  (scm_catch, scm_catch_with_pre_unwind_handler): Remove thread-unsafe
  lazy initialization.  Use 'catch_var'.
  (init_with_throw_handler_var): New static function.
  (scm_with_throw_handler): Remove thread-unsafe lazy initialization.
  Call 'init_with_throw_handler_var' using 'scm_i_pthread_once'.
  Use 'with_throw_handler_var'.
  (scm_throw): Remove thread-unsafe lazy initialization.
  Use 'throw_var'.
  (scm_init_throw): Initialize 'catch_var' and 'throw_var'.
---
 libguile/backtrace.c     |   20 ++++++++++++------
 libguile/continuations.c |   14 +++++++++---
 libguile/debug.c         |   20 ++++++++++--------
 libguile/eval.c          |   31 ++++++++++++++++++-----------
 libguile/frames.c        |   20 ++++++++++++------
 libguile/goops.c         |   19 ++++++++++++-----
 libguile/instructions.c  |   32 ++++++++++++++++++------------
 libguile/ports.c         |   32 +++++++++++++++---------------
 libguile/strings.c       |   17 ++++++++++-----
 libguile/strports.c      |   25 +++++++++++++----------
 libguile/throw.c         |   48 +++++++++++++++++++++------------------------
 11 files changed, 161 insertions(+), 117 deletions(-)

diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 7dd66ad..b0dc0f1 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/continuations.c b/libguile/continuations.c
index d991278..ad8885a 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -236,14 +236,20 @@ scm_i_make_continuation (int *first, SCM vm, SCM vm_cont)
 }
 #undef FUNC_NAME
 
+static SCM call_cc;
+
+static void
+init_call_cc (void)
+{
+  call_cc = scm_make_program (call_cc_objcode, SCM_BOOL_F, SCM_BOOL_F);
+}
+
 SCM
 scm_i_call_with_current_continuation (SCM proc)
 {
-  static SCM call_cc = SCM_BOOL_F;
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_call_cc);
 
-  if (scm_is_false (call_cc))
-    call_cc = scm_make_program (call_cc_objcode, SCM_BOOL_F, SCM_BOOL_F);
-  
   return scm_call_1 (call_cc, proc);
 }
 
diff --git a/libguile/debug.c b/libguile/debug.c
index 9e6328b..107b5d4 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -208,19 +208,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 6047d6d..815f7c7 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -642,30 +642,37 @@ SCM_DEFINE (scm_nconc2last, "apply:nconc2last", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+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 (scm_variable_ref (var),
+  return scm_apply (scm_variable_ref (map_var),
                     scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
 }
 
 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 (scm_variable_ref (var),
+  return scm_apply (scm_variable_ref (for_each_var),
                     scm_cons (proc, scm_cons (arg1, args)), SCM_EOL);
 }
 
diff --git a/libguile/frames.c b/libguile/frames.c
index a7143c4..9e77908 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -82,20 +82,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 9a40277..4a2e24d 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1763,15 +1763,22 @@ scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
   return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
 }
 
-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/instructions.c b/libguile/instructions.c
index ef4a9ce..30a47cf 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -82,25 +82,31 @@ fetch_instruction_table ()
   return table;
 }
 
+static SCM instructions_by_name;
+
+static void
+init_instructions_by_name (void)
+{
+  struct scm_instruction *table = fetch_instruction_table ();
+  unsigned int i;
+
+  instructions_by_name =
+    scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS));
+
+  for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
+    if (scm_is_true (table[i].symname))
+      scm_hashq_set_x (instructions_by_name, table[i].symname,
+                       SCM_I_MAKINUM (i));
+}
+
 static struct scm_instruction *
 scm_lookup_instruction_by_name (SCM name)
 {
-  static SCM instructions_by_name = SCM_BOOL_F;
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
   struct scm_instruction *table = fetch_instruction_table ();
   SCM op;
 
-  if (SCM_UNLIKELY (scm_is_false (instructions_by_name)))
-    {
-      unsigned int i;
-
-      instructions_by_name =
-        scm_make_hash_table (SCM_I_MAKINUM (SCM_VM_NUM_INSTRUCTIONS));
-
-      for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++)
-        if (scm_is_true (table[i].symname))
-          scm_hashq_set_x (instructions_by_name, table[i].symname,
-                           SCM_I_MAKINUM (i));
-    }
+  scm_i_pthread_once (&once, init_instructions_by_name);
 
   op = scm_hashq_ref (instructions_by_name, name, SCM_UNDEFINED);
   if (SCM_I_INUMP (op))
diff --git a/libguile/ports.c b/libguile/ports.c
index 4f401de..720ffc1 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -454,19 +454,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,
@@ -527,12 +530,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 1b241e5..cab5d05 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -260,6 +260,15 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 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;
@@ -267,17 +276,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 d1b293c..582b5e9 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -523,6 +523,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"
@@ -534,23 +544,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 7fc9edf..663a48b 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 ();                                                       \
-    }
-
 \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
@@ -534,8 +528,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"
 }
-- 
1.7.5.4

Re: [PATCH] Fix thread-unsafe lazy initializations

[Panicz Maciej Godek]

2014/1/23 Mark H Weaver <mhw@netris.org>:
> This patch fixes all of the thread-unsafe lazy initializations I could
> find in stable-2.0, using 'scm_i_pthread_once'.
>
> Any comments and/or objections?

Does this fix the error that Chris Vine found some time ago?
If so, is there any test in the test suite that failed before, and
doesn't fail anymore?
According to Ludovic, Chris' example corresponds to
test-pthread-create-secondary.c -- yet they differ in that guile's
test doesn't use scm_c_eval_string, which helped to reveal the
problem.
Shouldn't it be added to the test suite along with the patch, for regression?
Could we come up with any tests that would prove with certainty that
there are still some failures caused by lazy intializations of
modules? (e.g. would it help to write a test that loads all the
modules that are provided by guile, each in a separate thread?)
I hope that this is not a big faux pas :)

Thanks

Re: [PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

Panicz Maciej Godek <godek.maciek@gmail.com> writes:

> 2014/1/23 Mark H Weaver <mhw@netris.org>:
>> This patch fixes all of the thread-unsafe lazy initializations I could
>> find in stable-2.0, using 'scm_i_pthread_once'.
>>
>> Any comments and/or objections?
>
> Does this fix the error that Chris Vine found some time ago?

Probably not, but who knows?  Would you like to try?

There are definitely still thread-safety problems with module
autoloading.  I haven't fixed those yet.

> If so, is there any test in the test suite that failed before, and
> doesn't fail anymore?

No.

> According to Ludovic, Chris' example corresponds to
> test-pthread-create-secondary.c -- yet they differ in that guile's
> test doesn't use scm_c_eval_string, which helped to reveal the
> problem.
> Shouldn't it be added to the test suite along with the patch, for regression?

It would be a lot of work to add tests for all of these fixes, and I'm
not sure it would be easy to write tests that would detect these
problems with reasonably high probability.

Anyway, I'm already overloaded with work to do.
Would you like to do it?

> Could we come up with any tests that would prove with certainty that
> there are still some failures caused by lazy intializations of
> modules?

I don't need such a test.  It's obvious from the code that module
autoloading is not thread safe.

    Regards,
      Mark

Re: [PATCH] Fix thread-unsafe lazy initializations

[Panicz Maciej Godek]

2014/1/23 Mark H Weaver <mhw@netris.org>:
>> Does this fix the error that Chris Vine found some time ago?
>
> Probably not, but who knows?  Would you like to try?

Sure, but it will take some time, because I have to set up the build
environment first. I think I'll have it by tomorrow, if that's ok.

> There are definitely still thread-safety problems with module
> autoloading.  I haven't fixed those yet.
>
>> If so, is there any test in the test suite that failed before, and
>> doesn't fail anymore?
>
> No.
>
>> According to Ludovic, Chris' example corresponds to
>> test-pthread-create-secondary.c -- yet they differ in that guile's
>> test doesn't use scm_c_eval_string, which helped to reveal the
>> problem.
>> Shouldn't it be added to the test suite along with the patch, for regression?
>
> It would be a lot of work to add tests for all of these fixes, and I'm
> not sure it would be easy to write tests that would detect these
> problems with reasonably high probability.

But if you come up with some ideas, I'd be glad to hear them, and then
I could perhaps implement them. Maybe it would be a nice feature if
the "make check" instruction would generate a report that would gather
all the relevant information about the environment that could be sent
to some public address. That way we could increase the probability of
detecting various problems (especially those that appear randomly).
However, it would be a more serious enterprise, and I'd need some more
time than I have now to do it.

> Anyway, I'm already overloaded with work to do.
> Would you like to do it?

If it comes to regression test, I think I can handle it (and if I
don't, then I'll ask for some support). If it comes to other tests,
then I think that I'd need more guidance.

>> Could we come up with any tests that would prove with certainty that
>> there are still some failures caused by lazy intializations of
>> modules?
>
> I don't need such a test.  It's obvious from the code that module
> autoloading is not thread safe.

But they might prove good for the time when you progress with your
work to suspect that the issue is already solved :)

Re: [PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

Panicz Maciej Godek <godek.maciek@gmail.com> writes:

>>> According to Ludovic, Chris' example corresponds to
>>> test-pthread-create-secondary.c -- yet they differ in that guile's
>>> test doesn't use scm_c_eval_string, which helped to reveal the
>>> problem.
>>> Shouldn't it be added to the test suite along with the patch, for regression?

Here's what I should have written in response to the above: this will be
a good thing to do when I have a patch to fix Chris' problem.  However,
that's not what this patch is.

>> It would be a lot of work to add tests for all of these fixes, and I'm
>> not sure it would be easy to write tests that would detect these
>> problems with reasonably high probability.
>
> But if you come up with some ideas, I'd be glad to hear them, and then
> I could perhaps implement them. Maybe it would be a nice feature if
> the "make check" instruction would generate a report that would gather
> all the relevant information about the environment that could be sent
> to some public address.

I don't think such a thing belongs in "make check".  I'm not even sure
such a thing belongs in Guile.  I think it belongs in a separate bug
reporting tool.  Such projects already exist, such as ABRT.  The job is
pretty much the same for any piece of software, so it shouldn't be
reinvented in every piece of software.

>>> Could we come up with any tests that would prove with certainty that
>>> there are still some failures caused by lazy intializations of
>>> modules?
>>
>> I don't need such a test.  It's obvious from the code that module
>> autoloading is not thread safe.
>
> But they might prove good for the time when you progress with your
> work to suspect that the issue is already solved :)

Please, this is a discussion for another time.  I asked for comments
about the patch I just wrote.  I didn't ask for suggestions for new jobs
that I should do that are only vaguely related to the patch I just
wrote.  As I said, I'm overloaded enough as it is.

     Mark

Re: [PATCH] Fix thread-unsafe lazy initializations

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:
> This patch fixes all of the thread-unsafe lazy initializations I could
> find in stable-2.0, using 'scm_i_pthread_once'.

I went ahead and pushed this, since I'm confident it's correct.

     Mark