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: Wed, 25 Mar 2009 23:19:32 +0000
User-agent: Gnus/5.11 (Gnus v5.11) Emacs/22.2 (gnu/linux)

Neil Jerram <address@hidden> writes:

> Many thanks for your input on this.  I'll go ahead with a mutex or
> rwlock.  First thing is to see if it fixes the problem; if it does,
> I'll try to measure the performance impact.

Attached are 3 patches relating to thread-safe define.

#1 is Linas's test-define-race test, modified by me.  This test
reliably fails (without the following fix) if run for 200 seconds, but
I don't think we can have a test in Guile's "make check" that takes
200s.  Therefore I've coded it so that

- it runs for a duration specified by environment variable
  GUILE_TEST_DEFINE_RACE_DURATION

- it defaults to just 10s if that variable isn't defined.

So people who want to run this test meaningfully on their platforms
can do "GUILE_TEST_DEFINE_RACE_DURATION=200 make check".

#2 makes the symbols hash thread-safe, and it appears that this
completely fixes the define-race problem.  I don't understand why we
apparently don't need patch #3 as well - but that's what my results
indicate.

#3 allows a non-weak hash table to be automatically thread-safe, by
associating a fat mutex with it.

#3 is what I tried first, applying it to the module-obarray of the
(guile) and (guile-user) modules.  But test-define-race still gave
errors.  Then I added #2, and that fixed the errors.  Then I checked
#2 without #3, and that fixes all the test-define-race errors too.  So
apparently #3 is not needed.

It looks like we should commit #1 and #2 (although maybe with rwlock
instead of mutex), so please send any comments you have on those.  I'd
also appreciate thoughts on #3 as a possible hash table enhancement
(for master), and on why we don't apparently need to make the module
obarray hash tables thread-safe in this way.

Regards,
        Neil

>From 1f2707cc9473548863b483fd12d97afe7d0c94c2 Mon Sep 17 00:00:00 2001
From: Neil Jerram <address@hidden>
Date: Wed, 25 Mar 2009 20:55:37 +0000
Subject: [PATCH] New test for thread-safe define

Written by Linas Vepstas; modified by Neil Jerram.

* test-suite/standalone/Makefile.am: Add test-define-race test.

* test-suite/standalone/test-define-race.c: New test.
---
 test-suite/standalone/Makefile.am        |    5 +
 test-suite/standalone/test-define-race.c |  168 ++++++++++++++++++++++++++++++
 2 files changed, 173 insertions(+), 0 deletions(-)
 create mode 100644 test-suite/standalone/test-define-race.c

diff --git a/test-suite/standalone/Makefile.am 
b/test-suite/standalone/Makefile.am
index e7cfd82..766e447 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -145,6 +145,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..f375d55
--- /dev/null
+++ b/test-suite/standalone/test-define-race.c
@@ -0,0 +1,168 @@
+/* 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 * setup(void * ud)
+{
+  int *duration = (int *)ud;
+
+  /* Query an environment variable to find out how long to run this
+     test for, defaulting to 10s. */
+  *duration = scm_to_int (scm_c_eval_string ("(catch #t "
+    "(lambda () "
+    "  (round (string->number (string-append \"#e\" "
+                                   "(or (getenv 
\"GUILE_TEST_DEFINE_RACE_DURATION\") \"10\"))))) "
+    "(lambda _ "
+    "  (write _) (newline) 10))"));
+
+  return NULL;
+}
+
+int main(int argc, char ** argv)
+{
+  pthread_t th1, th2, th3, th4;
+  state counter1, counter2, counter3, counter4;
+  int error_total;
+  int duration;
+
+  scm_with_guile (setup, &duration);
+
+  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(duration);
+  counter1.do_exit = 1;
+  counter2.do_exit = 1;
+  counter3.do_exit = 1;
+  counter4.do_exit = 1;
+
+  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) in %ds\n", error_total, duration);
+  exit (error_total);
+}
-- 
1.5.6.5

>From 7b6b81cfef3705d20715b978b51004a8c4a6ddf6 Mon Sep 17 00:00:00 2001
From: Neil Jerram <address@hidden>
Date: Wed, 25 Mar 2009 22:34:23 +0000
Subject: [PATCH] Make the interned symbols hash thread-safe

These changes introduce a mutex that protects all accesses to and
modifications of the symbols hash.  They allow the test-define-race
test to run without errors for a long time.  (Well, for 200s anyway.)

* libguile/environments.c (obarray_enter, obarray_replace): Extra
  parameter on scm_i_rehash calls.

* libguile/hashtab.c: Include symbols.h.

  (scm_i_rehash): New mutex parameter.  When non-NULL, unlock and
  relock this mutex around allocations, and recheck new size
  calculation (in case another thread has changed it).

  (rehash_after_gc): Special treatment for the symbol hash.

  (scm_hash_fn_create_handle_x, scm_hash_fn_remove_x): Extra parameter on 
scm_i_rehash calls.

* libguile/hashtab.h (scm_i_rehash): New mutex parameter.

* libguile/symbols.c (symbols): Rename scm_i_symbols and make non-static.

  (symbols_mutex): New variable.

  (scm_sys_symbols): symbols -> scm_i_symbols.

  (lookup_interned_symbol): Lock symbols_mutex while performing lookup.

  (intern_symbol): Add name, len and raw_hash parameters.  Lock
  symbols_mutex while checking and modifying the symbols hash.  Once
  the mutex is locked, recheck in case another thread has already
  interned the symbol.  Return interned symbol, in order to tell
  callers about this last case.

  (scm_i_c_mem2symbol, scm_i_mem2symbol, scm_take_locale_symboln):
  Update intern_symbol calls.

  (scm_i_rehash_symbols_after_gc): New function.

  (scm_symbols_prehistory): symbols -> scm_i_symbols.  Initialize
  symbols_mutex.

* libguile/symbols.h (scm_i_symbols, scm_i_rehash_symbols_after_gc):
  New declarations.
---
 libguile/environments.c |    4 +-
 libguile/hashtab.c      |   53 +++++++++++++++++++--------
 libguile/hashtab.h      |    3 +-
 libguile/symbols.c      |   92 +++++++++++++++++++++++++++++++++++++----------
 libguile/symbols.h      |    2 +
 5 files changed, 117 insertions(+), 37 deletions(-)

diff --git a/libguile/environments.c b/libguile/environments.c
index 13d63c0..077a397 100644
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -516,7 +516,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
   SCM_SET_HASHTABLE_BUCKET  (obarray, hash, slot);
   SCM_HASHTABLE_INCREMENT (obarray);
   if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
-    scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_enter");
+    scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_enter", NULL);
 
   return entry;
 }
@@ -550,7 +550,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
   SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
   SCM_HASHTABLE_INCREMENT (obarray);
   if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
-    scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_replace");
+    scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_replace", NULL);
 
   return SCM_BOOL_F;
 }
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index ea7fc69..0292012 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -30,6 +30,7 @@
 #include "libguile/root.h"
 #include "libguile/vectors.h"
 #include "libguile/ports.h"
+#include "libguile/symbols.h"
 
 #include "libguile/validate.h"
 #include "libguile/hashtab.h"
@@ -117,13 +118,15 @@ void
 scm_i_rehash (SCM table,
              unsigned long (*hash_fn)(),
              void *closure,
-             const char* func_name)
+             const char* func_name,
+             scm_i_pthread_mutex_t *mutex)
 {
-  SCM buckets, new_buckets;
-  int i;
+  SCM buckets, new_buckets = SCM_BOOL_F;
+  int i = 0;
   unsigned long old_size;
   unsigned long new_size;
 
+ restart:
   if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
     {
       /* rehashing is not triggered when i <= min_size */
@@ -133,7 +136,7 @@ scm_i_rehash (SCM table,
       while (i > SCM_HASHTABLE (table)->min_size_index
             && SCM_HASHTABLE_N_ITEMS (table) < hashtable_size[i] / 4);
     }
-  else
+  else if (SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
     {
       i = SCM_HASHTABLE (table)->size_index + 1;
       if (i >= HASHTABLE_SIZE_N)
@@ -157,12 +160,28 @@ scm_i_rehash (SCM table,
   SCM_HASHTABLE (table)->upper = 9 * new_size / 10;
   buckets = SCM_HASHTABLE_VECTOR (table);
   
-  if (SCM_HASHTABLE_WEAK_P (table))
-    new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table),
-                                             scm_from_ulong (new_size),
-                                             SCM_EOL);
-  else
-    new_buckets = scm_c_make_vector (new_size, SCM_EOL);
+  if (scm_is_false (new_buckets) ||
+      (SCM_SIMPLE_VECTOR_LENGTH (new_buckets) != new_size))
+    {
+      /* Need to allocate or reallocate the new_buckets vector. */
+      if (mutex)
+       scm_i_pthread_mutex_unlock (mutex);
+
+      if (SCM_HASHTABLE_WEAK_P (table))
+       new_buckets = scm_i_allocate_weak_vector (SCM_HASHTABLE_FLAGS (table),
+                                                 scm_from_ulong (new_size),
+                                                 SCM_EOL);
+      else
+       new_buckets = scm_c_make_vector (new_size, SCM_EOL);
+
+      if (mutex)
+       scm_i_pthread_mutex_lock (mutex);
+
+      /* Another thread could have messed with the hashtable while the
+        mutex was unlocked.  So we now have to recalculate the rehash
+        size from scratch. */
+      goto restart;
+    }
 
   /* When this is a weak hashtable, running the GC might change it.
      We need to cope with this while rehashing its elements.  We do
@@ -271,11 +290,15 @@ rehash_after_gc (void *dummy1 SCM_UNUSED,
       h = first;
       do
        {
-         /* Rehash only when we have a hash_fn.
+         /* Special treatment for the symbol hash, as it is protected
+            by a mutex. */
+         if (scm_is_eq (h, scm_i_symbols))
+           scm_i_rehash_symbols_after_gc ();
+         /* Otherwise, rehash only when we have a hash_fn.
           */
-         if (SCM_HASHTABLE (h)->hash_fn)
+         else if (SCM_HASHTABLE (h)->hash_fn)
            scm_i_rehash (h, SCM_HASHTABLE (h)->hash_fn, NULL,
-                         "rehash_after_gc");
+                         "rehash_after_gc", NULL);
          last = h;
          h = SCM_HASHTABLE_NEXT (h);
        } while (!scm_is_null (h));
@@ -490,7 +513,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, 
unsigned long (*hash_
          SCM_HASHTABLE_INCREMENT (table);
          if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)
              || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
-           scm_i_rehash (table, hash_fn, closure, FUNC_NAME);
+           scm_i_rehash (table, hash_fn, closure, FUNC_NAME, NULL);
        }
       return SCM_CAR (new_bucket);
     }
@@ -556,7 +579,7 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
        {
          SCM_HASHTABLE_DECREMENT (table);
          if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table))
-           scm_i_rehash (table, hash_fn, closure, "scm_hash_fn_remove_x");
+           scm_i_rehash (table, hash_fn, closure, "scm_hash_fn_remove_x", 
NULL);
        }
     }
   return h;
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 1017354..3eca04c 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -96,7 +96,8 @@ SCM_API SCM scm_weak_key_hash_table_p (SCM h);
 SCM_API SCM scm_weak_value_hash_table_p (SCM h);
 SCM_API SCM scm_doubly_weak_hash_table_p (SCM h);
 
-SCM_API void scm_i_rehash (SCM table, unsigned long (*hash_fn)(), void 
*closure, const char*func_name);
+SCM_API void scm_i_rehash (SCM table, unsigned long (*hash_fn)(),
+                          void *closure, const char *func_name, 
scm_i_pthread_mutex_t *mutex);
 SCM_API void scm_i_scan_weak_hashtables (void);
 
 SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long 
(*hash_fn) (), SCM (*assoc_fn) (), void * closure);
diff --git a/libguile/symbols.c b/libguile/symbols.c
index b1329fa..a233fe3 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -46,7 +46,8 @@
 
 
 
-static SCM symbols;
+SCM scm_i_symbols;
+static scm_i_pthread_mutex_t symbols_mutex;
 
 #ifdef GUILE_DEBUG
 SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0,
@@ -54,7 +55,7 @@ SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0,
            "Return the system symbol obarray.")
 #define FUNC_NAME s_scm_sys_symbols
 {
-  return symbols;
+  return scm_i_symbols;
 }
 #undef FUNC_NAME
 #endif
@@ -90,9 +91,13 @@ lookup_interned_symbol (const char *name, size_t len,
 {
   /* Try to find the symbol in the symbols table */
   SCM l;
-  unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
+  unsigned long hash;
+
+  scm_i_pthread_mutex_lock (&symbols_mutex);
 
-  for (l = SCM_HASHTABLE_BUCKET (symbols, hash);
+  hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (scm_i_symbols);
+
+  for (l = SCM_HASHTABLE_BUCKET (scm_i_symbols, hash);
        !scm_is_null (l);
        l = SCM_CDR (l))
     {
@@ -110,31 +115,69 @@ lookup_interned_symbol (const char *name, size_t len,
                goto next_symbol;
            }
 
+         scm_i_pthread_mutex_unlock (&symbols_mutex);
          return sym;
        }
     next_symbol:
       ;
     }
 
+  scm_i_pthread_mutex_unlock (&symbols_mutex);
   return SCM_BOOL_F;
 }
 
 /* Intern SYMBOL, an uninterned symbol.  */
-static void
-intern_symbol (SCM symbol)
+static SCM
+intern_symbol (SCM symbol, const char *name, size_t len, size_t raw_hash)
 {
-  SCM slot, cell;
+  SCM slot, new_bucket, l;
   unsigned long hash;
 
-  hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (symbols);
-  slot = SCM_HASHTABLE_BUCKET (symbols, hash);
-  cell = scm_cons (symbol, SCM_UNDEFINED);
+  /* Allocate new cell and bucket before locking the mutex. */
+  new_bucket = scm_acons (symbol, SCM_UNDEFINED, SCM_BOOL_F);
+
+  scm_i_pthread_mutex_lock (&symbols_mutex);
+
+  hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (scm_i_symbols);
+  slot = SCM_HASHTABLE_BUCKET (scm_i_symbols, hash);
+
+  /* We have to check again here that the symbol isn't already hashed;
+     another thread could have interned it inbetween when we tried to
+     look up the symbol and the scm_i_pthread_mutex_lock call
+     above. */
+  for (l = slot; !scm_is_null (l); l = SCM_CDR (l))
+    {
+      SCM sym = SCM_CAAR (l);
+      if ((scm_i_symbol_hash (sym) == raw_hash) &&
+         (scm_i_symbol_length (sym) == len))
+       {
+         const char *chrs = scm_i_symbol_chars (sym);
+         size_t i = len;
+
+         while (i != 0)
+           {
+             --i;
+             if (name[i] != chrs[i])
+               goto next_symbol;
+           }
+
+         scm_i_pthread_mutex_unlock (&symbols_mutex);
+         return sym;
+       }
+    next_symbol:
+      ;
+    }
+
+  SCM_SETCDR (new_bucket, slot);
+  SCM_SET_HASHTABLE_BUCKET (scm_i_symbols, hash, new_bucket);
+  SCM_HASHTABLE_INCREMENT (scm_i_symbols);
+  if (SCM_HASHTABLE_N_ITEMS (scm_i_symbols) > SCM_HASHTABLE_UPPER 
(scm_i_symbols))
+    scm_i_rehash (scm_i_symbols, scm_i_hash_symbol, 0, "intern_symbol",
+                 &symbols_mutex);
 
-  SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
-  SCM_HASHTABLE_INCREMENT (symbols);
+  scm_i_pthread_mutex_unlock (&symbols_mutex);
 
-  if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols))
-    scm_i_rehash (symbols, scm_i_hash_symbol, 0, "intern_symbol");
+  return symbol;
 }
 
 static SCM
@@ -149,7 +192,7 @@ scm_i_c_mem2symbol (const char *name, size_t len)
       /* The symbol was not found, create it.  */
       symbol = scm_i_c_make_symbol (name, len, 0, raw_hash,
                                    scm_cons (SCM_BOOL_F, SCM_EOL));
-      intern_symbol (symbol);
+      symbol = intern_symbol (symbol, name, len, raw_hash);
     }
 
   return symbol;
@@ -169,12 +212,22 @@ scm_i_mem2symbol (SCM str)
       /* The symbol was not found, create it.  */
       symbol = scm_i_make_symbol (str, 0, raw_hash,
                                  scm_cons (SCM_BOOL_F, SCM_EOL));
-      intern_symbol (symbol);
+      symbol = intern_symbol (symbol, name, len, raw_hash);
     }
 
   return symbol;
 }
 
+void
+scm_i_rehash_symbols_after_gc ()
+{
+  scm_i_pthread_mutex_lock (&symbols_mutex);
+
+  scm_i_rehash (scm_i_symbols, scm_i_hash_symbol, 0, "rehash_after_gc",
+               &symbols_mutex);
+
+  scm_i_pthread_mutex_unlock (&symbols_mutex);
+}
 
 static SCM
 scm_i_mem2uninterned_symbol (SCM str)
@@ -417,7 +470,7 @@ scm_take_locale_symboln (char *sym, size_t len)
     {
       res = scm_i_c_take_symbol (sym, len, 0, raw_hash,
                                 scm_cons (SCM_BOOL_F, SCM_EOL));
-      intern_symbol (res);
+      res = intern_symbol (res, sym, len, raw_hash);
     }
   else
     free (sym);
@@ -434,8 +487,9 @@ scm_take_locale_symbol (char *sym)
 void
 scm_symbols_prehistory ()
 {
-  symbols = scm_make_weak_key_hash_table (scm_from_int (2139));
-  scm_permanent_object (symbols);
+  scm_i_symbols = scm_make_weak_key_hash_table (scm_from_int (2139));
+  scm_permanent_object (scm_i_symbols);
+  scm_i_pthread_mutex_init (&symbols_mutex, NULL);
 }
 
 
diff --git a/libguile/symbols.h b/libguile/symbols.h
index f70d655..30c3005 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -34,6 +34,7 @@
 #define SCM_I_F_SYMBOL_UNINTERNED   0x100
 
 
+extern SCM scm_i_symbols;
 
 #ifdef GUILE_DEBUG
 SCM_API SCM scm_sys_symbols (void);
@@ -63,6 +64,7 @@ SCM_API SCM scm_take_locale_symboln (char *sym, size_t len);
 
 SCM_API unsigned long scm_i_hash_symbol (SCM obj, unsigned long n,
                                         void *closure);
+void scm_i_rehash_symbols_after_gc (void);
 
 SCM_API void scm_symbols_prehistory (void);
 SCM_API void scm_init_symbols (void);
-- 
1.5.6.5

>From 7627abf6ecf1770367ea2c5f8d61e14fa4843c8a Mon Sep 17 00:00:00 2001
From: Neil Jerram <address@hidden>
Date: Wed, 25 Mar 2009 22:50:46 +0000
Subject: [PATCH] Allow non-weak hash tables to be automatically thread-safe

This patch allows a fat mutex to be associated with a hash table.
When a hash table has an associated mutex, that mutex will be
automatically locked and unlocked around all operations (include
lookups) on the hash table's internal data.

* libguile/hashtab.c (make_hash_table): Init mutex field to #f.

  (hashtable_mark): New function.

  (scm_hash_fn_get_handle, scm_hash_fn_create_handle_x,
  scm_hash_fn_remove_x, scm_hash_clear_x, scm_internal_hash_fold,
  scm_internal_hash_for_each_handle): If the hash table has a mutex,
  lock and unlock it around all accessing of the hash table's
  internals.

  (scm_hash_use_mutex_x): New function.

  (scm_hashtab_prehistory): Use hashtable_mark as hash table mark
  function.

* libguile/hashtab.h (SCM_HASHTABLE_MUTEX, SCM_SET_HASHTABLE_MUTEX,
  scm_hash_use_mutex_x): New declarations.

  (scm_t_hashtable): New mutex field.
---
 libguile/hashtab.c |  130 ++++++++++++++++++++++++++++++++++++++++++++++------
 libguile/hashtab.h |    4 ++
 2 files changed, 119 insertions(+), 15 deletions(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 0292012..7621314 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -104,6 +104,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);
@@ -218,6 +219,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)
 {
@@ -440,18 +448,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
@@ -463,10 +487,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),
@@ -481,7 +513,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
@@ -515,8 +547,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, NULL);
        }
-      return SCM_CAR (new_bucket);
+      it = SCM_CAR (new_bucket);
     }
+
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
+
+  return it;
 }
 #undef FUNC_NAME
 
@@ -554,10 +591,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,
@@ -565,7 +610,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))
@@ -582,6 +630,9 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
            scm_i_rehash (table, hash_fn, closure, "scm_hash_fn_remove_x", 
NULL);
        }
     }
+ end:
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
   return h;
 }
 
@@ -592,8 +643,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);
@@ -940,10 +999,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;
   
@@ -963,6 +1030,9 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM 
init, SCM table)
        }
     }
 
+  if (!scm_is_false (mutex))
+    scm_dynwind_end ();
+
   return result;
 }
 
@@ -978,10 +1048,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;
   
@@ -1000,6 +1078,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, 
@@ -1088,6 +1169,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
+
 
 
 
@@ -1095,7 +1195,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 3eca04c..79cb30c 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;
 
 
@@ -133,6 +136,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);
 
-- 
1.5.6.5


reply via email to

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