guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Locks and threads


From: Neil Jerram
Subject: Re: Locks and threads
Date: Thu, 12 Mar 2009 00:07:16 +0000
User-agent: Gnus/5.11 (Gnus v5.11) Emacs/22.2 (gnu/linux)

Neil Jerram <address@hidden> writes:

>> next it's on to the real problem, threadsafe define.
>
> I've been running Linas's define-race test program, and hitting the
> `throw from within critical section' quite a lot. [...]

After the patch that I posted yesterday, we finally get to the real
problem.  I've tried to address it by allowing a hashtable to have a
mutex associated with it - resulting in the patch below.  But
unfortunately it's still not good; a sample run of test-define-race
gives:

#<module (guile) 40376f00>
#<directory (guile-user) 40379680>
ERROR: ERROR: Unbound variable: x1-100499
Unbound variable: define
ERROR: Unbound variable: x4-100596
ERROR: Unbound variable: define
ERROR: Unbound variable: define
ERROR: Unbound variable: define
guile-define test case: good-bye!
test-define-race: 2 error(s)
FAIL: test-define-race

I'm off to sleep now, so I thought I'd post what I've done in case
others have thoughts on it or can see something wrong.

Regards,
        Neil

>From fd6931d5694f336aac9b9c5179dc0a4fc6f2c4c5 Mon Sep 17 00:00:00 2001
From: Neil Jerram <address@hidden>
Date: Wed, 11 Mar 2009 23:54:38 +0000
Subject: [PATCH] Work on define race

---
 libguile/hashtab.c                       |  130 +++++++++++++++++++++---
 libguile/hashtab.h                       |    4 +
 libguile/modules.c                       |    1 -
 libguile/throw.c                         |    5 +-
 test-suite/standalone/Makefile.am        |    5 +
 test-suite/standalone/test-define-race.c |  163 ++++++++++++++++++++++++++++++
 6 files changed, 291 insertions(+), 17 deletions(-)
 create mode 100644 test-suite/standalone/test-define-race.c

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index ea7fc69..098b610 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -103,6 +103,7 @@ make_hash_table (int flags, unsigned long k, const char 
*func_name)
   t->upper = 9 * n / 10;
   t->flags = flags;
   t->hash_fn = NULL;
+  t->mutex = SCM_BOOL_F;
   if (flags)
     {
       SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, weak_hashtables);
@@ -199,6 +200,13 @@ scm_i_rehash (SCM table,
 }
 
 
+static SCM 
+hashtable_mark (SCM table)
+{
+  scm_gc_mark (SCM_HASHTABLE_MUTEX (table));
+  return SCM_CELL_OBJECT_1 (table);
+}
+
 static int
 hashtable_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
@@ -417,18 +425,34 @@ scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long 
(*hash_fn)(), SCM (*as
 #define FUNC_NAME "scm_hash_fn_get_handle"
 {
   unsigned long k;
-  SCM h;
+  SCM h, mutex = SCM_BOOL_F;
 
   if (SCM_HASHTABLE_P (table))
-    table = SCM_HASHTABLE_VECTOR (table);
+    {
+      mutex = SCM_HASHTABLE_MUTEX (table);
+      if (!scm_is_false (mutex))
+       {
+         scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+         scm_dynwind_lock_mutex (mutex);
+       }
+      table = SCM_HASHTABLE_VECTOR (table);
+    }
   else
     SCM_VALIDATE_VECTOR (1, table);
   if (SCM_SIMPLE_VECTOR_LENGTH (table) == 0)
-    return SCM_BOOL_F;
+    {
+      h = SCM_BOOL_F;
+      goto end;
+    }
   k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (table), closure);
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (table))
     scm_out_of_range ("hash_fn_get_handle", scm_from_ulong (k));
   h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (table, k), closure);
+
+ end:
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
+
   return h;
 }
 #undef FUNC_NAME
@@ -440,10 +464,18 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM 
init, unsigned long (*hash_
 #define FUNC_NAME "scm_hash_fn_create_handle_x"
 {
   unsigned long k;
-  SCM buckets, it;
+  SCM buckets, it, mutex = SCM_BOOL_F;
 
   if (SCM_HASHTABLE_P (table))
-    buckets = SCM_HASHTABLE_VECTOR (table);
+    {
+      mutex = SCM_HASHTABLE_MUTEX (table);
+      if (!scm_is_false (mutex))
+       {
+         scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+         scm_dynwind_lock_mutex (mutex);
+       }
+      buckets = SCM_HASHTABLE_VECTOR (table);
+    }
   else
     {
       SCM_ASSERT (scm_is_simple_vector (table),
@@ -458,7 +490,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_
     scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k));
   it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
   if (scm_is_pair (it))
-    return it;
+    ;
   else if (scm_is_true (it))
     scm_wrong_type_arg_msg (NULL, 0, it, "a pair");
   else
@@ -492,8 +524,13 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_
              || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
            scm_i_rehash (table, hash_fn, closure, FUNC_NAME);
        }
-      return SCM_CAR (new_bucket);
+      it = SCM_CAR (new_bucket);
     }
+
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
+
+  return it;
 }
 #undef FUNC_NAME
 
@@ -531,10 +568,18 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
                       void *closure)
 {
   unsigned long k;
-  SCM buckets, h;
+  SCM buckets, h, mutex = SCM_BOOL_F;
 
   if (SCM_HASHTABLE_P (table))
-    buckets = SCM_HASHTABLE_VECTOR (table);
+    {
+      mutex = SCM_HASHTABLE_MUTEX (table);
+      if (!scm_is_false (mutex))
+       {
+         scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+         scm_dynwind_lock_mutex (mutex);
+       }
+      buckets = SCM_HASHTABLE_VECTOR (table);
+    }
   else
     {
       SCM_ASSERT (scm_is_simple_vector (table), table,
@@ -542,7 +587,10 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
       buckets = table;
     }
   if (SCM_SIMPLE_VECTOR_LENGTH (table) == 0)
-    return SCM_EOL;
+    {
+      h = SCM_EOL;
+      goto end;
+    }
 
   k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure);
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
@@ -559,6 +607,9 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
            scm_i_rehash (table, hash_fn, closure, "scm_hash_fn_remove_x");
        }
     }
+ end:
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
   return h;
 }
 
@@ -569,8 +620,16 @@ SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0,
 {
   if (SCM_HASHTABLE_P (table))
     {
+      SCM mutex = SCM_HASHTABLE_MUTEX (table);
+      if (!scm_is_false (mutex))
+       {
+         scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+         scm_dynwind_lock_mutex (mutex);
+       }
       scm_vector_fill_x (SCM_HASHTABLE_VECTOR (table), SCM_EOL);
       SCM_SET_HASHTABLE_N_ITEMS (table, 0);
+      if (!scm_is_false (mutex))
+       scm_dynwind_end ();
     }
   else
     scm_vector_fill_x (table, SCM_EOL);
@@ -917,10 +976,18 @@ SCM
 scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
 {
   long i, n;
-  SCM buckets, result = init;
+  SCM buckets, result = init, mutex = SCM_BOOL_F;
   
   if (SCM_HASHTABLE_P (table))
-    buckets = SCM_HASHTABLE_VECTOR (table);
+    {
+      mutex = SCM_HASHTABLE_MUTEX (table);
+      if (!scm_is_false (mutex))
+       {
+         scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+         scm_dynwind_lock_mutex (mutex);
+       }
+      buckets = SCM_HASHTABLE_VECTOR (table);
+    }
   else
     buckets = table;
   
@@ -940,6 +1007,9 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM 
init, SCM table)
        }
     }
 
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
+
   return result;
 }
 
@@ -955,10 +1025,18 @@ void
 scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
 {
   long i, n;
-  SCM buckets;
+  SCM buckets, mutex = SCM_BOOL_F;
   
   if (SCM_HASHTABLE_P (table))
-    buckets = SCM_HASHTABLE_VECTOR (table);
+    {
+      mutex = SCM_HASHTABLE_MUTEX (table);
+      if (!scm_is_false (mutex))
+       {
+         scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+         scm_dynwind_lock_mutex (mutex);
+       }
+      buckets = SCM_HASHTABLE_VECTOR (table);
+    }
   else
     buckets = table;
   
@@ -977,6 +1055,9 @@ scm_internal_hash_for_each_handle (SCM (*fn) (), void 
*closure, SCM table)
          ls = SCM_CDR (ls);
        }
     }
+
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
 }
 
 SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, 
@@ -1065,6 +1146,25 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 
0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_hash_use_mutex_x, "hash-use-mutex!", 2, 0, 0, 
+            (SCM table, SCM mutex),
+           "Use @var{mutex} to serialize operations on @var{table} from 
multiple threads.")
+#define FUNC_NAME s_scm_hash_use_mutex_x
+{
+  /* Must be a real (i.e. not a vector) and non-weak hash table. */
+  SCM_VALIDATE_HASHTABLE (1, table);
+  if (SCM_HASHTABLE_WEAK_P (table))
+    SCM_MISC_ERROR ("can't use mutex with a weak hash table", SCM_EOL);
+    
+  if (!scm_is_false (mutex))
+    SCM_VALIDATE_MUTEX (2, mutex);
+
+  SCM_SET_HASHTABLE_MUTEX (table, mutex);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 
 
 
@@ -1072,7 +1172,7 @@ void
 scm_hashtab_prehistory ()
 {
   scm_tc16_hashtable = scm_make_smob_type (s_hashtable, 0);
-  scm_set_smob_mark (scm_tc16_hashtable, scm_markcdr);
+  scm_set_smob_mark (scm_tc16_hashtable, hashtable_mark);
   scm_set_smob_print (scm_tc16_hashtable, hashtable_print);
   scm_set_smob_free (scm_tc16_hashtable, hashtable_free);
   scm_c_hook_add (&scm_after_gc_c_hook, rehash_after_gc, 0, 0);
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 1017354..250f59a 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -58,6 +58,8 @@ SCM_API scm_t_bits scm_tc16_hashtable;
 #define SCM_HASHTABLE_DECREMENT(x) (SCM_HASHTABLE_N_ITEMS(x)--)
 #define SCM_HASHTABLE_UPPER(x)     (SCM_HASHTABLE (x)->upper)
 #define SCM_HASHTABLE_LOWER(x)     (SCM_HASHTABLE (x)->lower)
+#define SCM_HASHTABLE_MUTEX(x)     (SCM_HASHTABLE (x)->mutex)
+#define SCM_SET_HASHTABLE_MUTEX(x, m)     (SCM_HASHTABLE (x)->mutex = m)
 
 #define SCM_HASHTABLE_N_BUCKETS(h) \
  SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (h))
@@ -74,6 +76,7 @@ typedef struct scm_t_hashtable {
   int size_index;              /* index into hashtable_size */
   int min_size_index;          /* minimum size_index */
   unsigned long (*hash_fn) ();  /* for rehashing after a GC. */
+  SCM mutex;                   /* mutex for thread safety */
 } scm_t_hashtable;
 
 
@@ -132,6 +135,7 @@ SCM_API SCM scm_hash_fold (SCM proc, SCM init, SCM hash);
 SCM_API SCM scm_hash_for_each (SCM proc, SCM hash);
 SCM_API SCM scm_hash_for_each_handle (SCM proc, SCM hash);
 SCM_API SCM scm_hash_map_to_list (SCM proc, SCM hash);
+SCM_API SCM scm_hash_use_mutex_x (SCM hash, SCM mutex);
 SCM_API void scm_hashtab_prehistory (void);
 SCM_API void scm_init_hashtab (void);
 
diff --git a/libguile/modules.c b/libguile/modules.c
index 444ece1..da397d8 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -279,7 +279,6 @@ SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0,
  * C level implementation of the standard eval closure
  *
  * This increases loading speed substantially.
- * The code will be replaced by the low-level environments in next release.
  */
 
 static SCM module_make_local_var_x_var;
diff --git a/libguile/throw.c b/libguile/throw.c
index 92c5a1a..b2ec371 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -264,6 +264,7 @@ scm_c_with_throw_handler (SCM tag,
 {
   SCM pre_unwind, answer;
   struct pre_unwind_data c;
+  SCM new_dynwinds;
 
   c.handler = handler;
   c.handler_data = handler_data;
@@ -272,7 +273,9 @@ scm_c_with_throw_handler (SCM tag,
   pre_unwind = make_pre_unwind_data (&c);
 
   SCM_CRITICAL_SECTION_START;
-  scm_i_set_dynwinds (scm_acons (tag, pre_unwind, scm_i_dynwinds ()));
+  new_dynwinds = scm_acons (tag, pre_unwind, SCM_BOOL_F);
+  SCM_SETCDR (new_dynwinds, scm_i_dynwinds ());
+  scm_i_set_dynwinds (new_dynwinds);
   SCM_CRITICAL_SECTION_END;
 
   answer = (*body) (body_data);
diff --git a/test-suite/standalone/Makefile.am 
b/test-suite/standalone/Makefile.am
index 356573f..bb2f089 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -137,6 +137,11 @@ test_scm_with_guile_LDADD = 
${top_builddir}/libguile/libguile.la
 check_PROGRAMS += test-scm-with-guile
 TESTS += test-scm-with-guile
 
+test_define_race_CFLAGS = ${test_cflags}
+test_define_race_LDADD = ${top_builddir}/libguile/libguile.la
+check_PROGRAMS += test-define-race
+TESTS += test-define-race
+
 else
 
 EXTRA_DIST += test-with-guile-module.c test-scm-with-guile.c
diff --git a/test-suite/standalone/test-define-race.c 
b/test-suite/standalone/test-define-race.c
new file mode 100644
index 0000000..a79dcee
--- /dev/null
+++ b/test-suite/standalone/test-define-race.c
@@ -0,0 +1,163 @@
+/* Copyright (C) 2009 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 as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+/*
+ * test-define-race.c
+ *
+ * Program to exhibit a race in the guile-1.8.x define code.
+ * See https://savannah.gnu.org/bugs/index.php?24867 for general 
+ * status and description.
+ *
+ * Summary: variable definition and lookup is not thread-safe in guile;
+ * attempting to look up a variable while another thread is defining 
+ * a variable can sometimes lead to the first thread loosing, and not
+ * seeing an existing, defined variable. Alternately, difining two
+ * different variables at the same time can result in one of them
+ * failing to be defined; on rarer occasions, a seg-fault results.
+ *
+ * Compile as:
+ * cc test-define-race.c -lpthread -lguile
+ *
+ * May need to run several times to see the bug(s).
+ *
+ * Linas Vepstas <address@hidden> December 2008
+ */
+
+#include <libguile.h>
+#include <pthread.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+typedef struct
+{
+  int id;
+  int count;
+  int do_exit;
+  int error_count;
+  int last_ok;
+
+} state;
+
+static void * guile_mode_definer(void * ud)
+{
+  SCM result;
+  int val;
+
+  char buff[1000];
+  state * s = (state *) ud;
+
+  /* Increment before evaluation, in case evaluation raises an
+     error. */
+  s->count ++;
+  
+  if (s->last_ok)
+    {
+      /* See if the previous definition holds the expected value.  If
+        the expected value is undefined, scm_c_eval_string will raise
+        an error. */
+      s->error_count ++;
+      s->last_ok = 0;
+      sprintf (buff, "x%d-%d\n", s->id, s->count - 1);
+      result = scm_c_eval_string (buff);
+      val = scm_to_int(result);
+
+      if (val != s->count - 1)
+       printf ("Define mismatch on thread %d\n", s->id);
+      else
+       s->error_count --;
+    }
+
+  /* Define a new variable with a new value. */
+  sprintf (buff, "(define x%d-%d %d)\n", s->id, s->count, s->count);
+  scm_c_eval_string (buff);
+
+  /* If we reach here, the definition was apparently successful, so we
+     can check it on the next iteration. */
+  s->last_ok = 1;
+
+  return NULL;
+}
+
+static void * definer (void *ud)
+{
+  int i;
+  state * s = (state *) ud;
+
+  while(!s->do_exit)
+    for (i=0; i<4000; i++)
+      {
+       scm_with_guile (guile_mode_definer, ud);
+       sched_yield();  /* try to get the threads to inter-leave a lot */
+      }
+  return NULL;
+}
+
+static void init_ctr(state *s, int val)
+{
+  s->id = val;
+  s->count = 0;
+  s->do_exit = 0;
+  s->error_count = 0;
+  s->last_ok = 0;
+}
+
+static void * be_threadsafe(void * ud)
+{
+  scm_c_eval_string ("(begin (write the-root-module) (newline))");
+  scm_c_eval_string ("(begin (write (module-obarray the-root-module)) 
(newline))");
+  scm_c_eval_string ("(hash-use-mutex! (module-obarray the-root-module) 
(make-mutex))");
+  scm_c_eval_string ("(begin (write (current-module)) (newline))");
+  scm_c_eval_string ("(begin (write (module-obarray (current-module))) 
(newline))");
+  scm_c_eval_string ("(hash-use-mutex! (module-obarray (current-module)) 
(make-mutex))");
+  return NULL;
+}
+
+int main(int argc, char ** argv)
+{
+  pthread_t th1, th2, th3, th4;
+  state counter1, counter2, counter3, counter4;
+  int error_total;
+
+  scm_with_guile (be_threadsafe, NULL);
+
+  init_ctr (&counter1, 1);
+  init_ctr (&counter2, 2);
+  init_ctr (&counter3, 3);
+  init_ctr (&counter4, 4);
+
+  pthread_create(&th1, NULL, definer, (void *) &counter1);
+  pthread_create(&th2, NULL, definer, (void *) &counter2);
+  pthread_create(&th3, NULL, definer, (void *) &counter3);
+  pthread_create(&th4, NULL, definer, (void *) &counter4);
+
+  sleep(200);
+  counter1.do_exit = 1;
+  counter2.do_exit = 1;
+  counter3.do_exit = 1;
+  counter4.do_exit = 1;
+  printf ("guile-define test case: good-bye!\n");
+
+  pthread_join(th1, NULL);
+  pthread_join(th2, NULL);
+  pthread_join(th3, NULL);
+  pthread_join(th4, NULL);
+
+  error_total = (counter1.error_count + counter2.error_count +
+                counter3.error_count + counter4.error_count);
+  printf("test-define-race: %d error(s)\n", error_total);
+  exit (error_total);
+}
-- 
1.5.6.5


reply via email to

[Prev in Thread] Current Thread [Next in Thread]