Using thread-local storage

[Ludovic Courtès]

Hi,

Andy, our chief profiler ;-), reported that a fair amount of time was
spent in `pthread_getspecific ()' (in a thread-enabled build).  Indeed,
the current-thread object and more importantly freelists are accessed
this way.  Thus we thought that using thread-local storage (TLS) would
be helpful[*].

The patch below (against HEAD, but should apply to 1.8) allows Guile to
use TLS (where available) for `SCM_I_CURRENT_THREAD' and for the
freelists.  However, after only some light benchmarking running
`gcbench.scm', the effect does not appear to be as expected, even
slightly negative at times.

I'd be happy if someone could explain me this phenomenon or do
additional profiling.

Thanks,
Ludovic.

[*] Boehm-D-W GC, for instance, significantly benefits from TLS:
    
http://article.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/1516/


--- orig/configure.in
+++ mod/configure.in
@@ -1199,6 +1199,18 @@ AC_DEFINE(PTHREAD_ATTR_GETSTACK_WORKS, [
 CFLAGS="$old_CFLAGS"
 AC_MSG_RESULT($works)
 
+
+# Check whether the `__thread' storage class is available.
+AC_MSG_CHECKING(whether the `__thread' storage class is available)
+AC_COMPILE_IFELSE([static __thread int foo; int func (int x) { return (x + 
foo); }],
+  [have_thread_storage_class=yes], [have_thread_storage_class=no])
+AC_MSG_RESULT($have_thread_storage_class)
+if test "x$have_thread_storage_class" = "xyes"; then
+   SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS=1
+else
+   SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS=0
+fi
+
 fi # with_threads=pthreads
 
 
@@ -1345,6 +1357,7 @@ AC_SUBST([SCM_I_GSC_ENABLE_DEPRECATED])
 AC_SUBST([SCM_I_GSC_ENABLE_ELISP])
 AC_SUBST([SCM_I_GSC_STACK_GROWS_UP])
 AC_SUBST([SCM_I_GSC_C_INLINE])
+AC_SUBST([SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS])
 AC_CONFIG_FILES([libguile/gen-scmconfig.h])
 
 AC_CONFIG_FILES([
--- orig/libguile/__scm.h
+++ mod/libguile/__scm.h
@@ -3,7 +3,7 @@
 #ifndef SCM___SCM_H
 #define SCM___SCM_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007 Free 
Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -615,6 +615,14 @@ SCM_API SCM scm_apply_generic (SCM gf, S
 #define SCM_C_INLINE_KEYWORD
 #endif
 
+/* Handling thread-local storage (TLS).  */
+
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+# define SCM_THREAD_LOCAL __thread
+#else
+# define SCM_THREAD_LOCAL
+#endif
+
 #endif  /* SCM___SCM_H */
 
 /*
--- orig/libguile/gc.c
+++ mod/libguile/gc.c
@@ -82,6 +82,18 @@ int scm_debug_cells_gc_interval = 0;
  */
 int scm_i_cell_validation_already_running ;
 
+
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+
+/* When thread-local storage (TLS) is supported, we keep freelists in
+   thread-local storage.  This allows for faster access compared to
+   `pthread_{get,set}specific ()'.  */
+SCM_THREAD_LOCAL SCM *scm_i_freelist_loc = NULL;
+SCM_THREAD_LOCAL SCM *scm_i_freelist2_loc = NULL;
+
+#endif /* SCM_HAVE_THREAD_STORAGE_CLASS */
+
+
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
 
 
--- orig/libguile/gc.h
+++ mod/libguile/gc.h
@@ -270,10 +270,34 @@ SCM_API size_t scm_default_max_segment_s
 
 SCM_API size_t scm_max_segment_size;
 
-#define SCM_SET_FREELIST_LOC(key,ptr) scm_i_pthread_setspecific ((key), (ptr))
-#define SCM_FREELIST_LOC(key) ((SCM *) scm_i_pthread_getspecific (key))
 SCM_API scm_i_pthread_key_t scm_i_freelist;
 SCM_API scm_i_pthread_key_t scm_i_freelist2;
+
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+
+SCM_API SCM_THREAD_LOCAL SCM *scm_i_freelist_loc;
+SCM_API SCM_THREAD_LOCAL SCM *scm_i_freelist2_loc;
+
+/* For binary compatibility, we also update the data associated with KEY
+   using `pthread_setspecific ()'.  */
+#define SCM_SET_FREELIST_LOC(key,ptr)          \
+do                                             \
+{                                              \
+  key ## _loc = ptr;                           \
+  scm_i_pthread_setspecific ((key), (ptr));    \
+}                                              \
+while (0)
+
+#define SCM_FREELIST_LOC(key)  (key ## _loc)
+
+#else /* !SCM_HAVE_THREAD_STORAGE_CLASS */
+
+#define SCM_SET_FREELIST_LOC(key,ptr)  scm_i_pthread_setspecific ((key), (ptr))
+#define SCM_FREELIST_LOC(key) ((SCM *) scm_i_pthread_getspecific (key))
+
+#endif /* SCM_HAVE_THREAD_STORAGE_CLASS */
+
+
 SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
 SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
 
--- orig/libguile/gen-scmconfig.c
+++ mod/libguile/gen-scmconfig.c
@@ -382,6 +382,13 @@ main (int argc, char *argv[])
   pf ("#define SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT %d /* 0 or 1 */\n",
       SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT);
 
+  if (SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS)
+    {
+      pf ("/* Define the 1 if the compiler supports the "
+         "`__thread' storage class.  */\n");
+      pf ("#define SCM_HAVE_THREAD_STORAGE_CLASS 1\n");
+    }
+
 #if USE_DLL_IMPORT
   pf ("\n");
   pf ("/* Define some additional CPP macros on Win32 platforms. */\n");
--- orig/libguile/gen-scmconfig.h.in
+++ mod/libguile/gen-scmconfig.h.in
@@ -29,6 +29,7 @@
 #define SCM_I_GSC_USE_PTHREAD_THREADS @SCM_I_GSC_USE_PTHREAD_THREADS@
 #define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
 #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT 
@SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
+#define SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS 
@SCM_I_GSC_HAVE_THREAD_STORAGE_CLASS@
 
 /*
   Local Variables:
--- orig/libguile/threads.c
+++ mod/libguile/threads.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 
2007 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
@@ -351,6 +351,22 @@ unblock_from_queue (SCM queue)
    pthread_cancel.)
 */
 
+
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+
+/* When thread-local storage (TLS) is available, a pointer to the
+   current-thread object is kept in TLS.  Note that storing the thread-object
+   itself in TLS (rather than a pointer to some malloc'd memory) is not
+   possible since thread objects may live longer than the actual thread they
+   represent.  */
+SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread = NULL;
+
+#endif
+
+
+/* Key used to retrieve the current thread with `pthread_getspecific ()'.
+   This is not needed when TLS is available but having it can't hurt and
+   maintains binary compatibility.  */
 scm_i_pthread_key_t scm_i_thread_key;
 
 static void
@@ -441,8 +457,16 @@ guilify_self_1 (SCM_STACKITEM *base)
   SCM_SET_FREELIST_LOC (scm_i_freelist, &t->freelist);
   SCM_SET_FREELIST_LOC (scm_i_freelist2, &t->freelist2);
 
+  /* Associate with SCM_I_THREAD_KEY a pointer to T.  Even when
+     `SCM_HAVE_THREAD_STORAGE_CLASS', this is needed to maintain binary
+     compatibility.  */
   scm_i_pthread_setspecific (scm_i_thread_key, t);
 
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+  /* Keep a pointer to T in thread-local storage.  */
+  scm_i_current_thread = t;
+#endif
+
   scm_i_pthread_mutex_lock (&t->heap_mutex);
 
   scm_i_pthread_mutex_lock (&thread_admin_mutex);
@@ -520,6 +544,10 @@ on_thread_exit (void *v)
   scm_i_pthread_mutex_unlock (&thread_admin_mutex);
 
   scm_i_pthread_setspecific (scm_i_thread_key, NULL);
+
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+  scm_i_current_thread = NULL;
+#endif
 }
 
 static scm_i_pthread_once_t init_thread_key_once = SCM_I_PTHREAD_ONCE_INIT;
@@ -549,7 +577,8 @@ scm_i_init_thread_for_guile (SCM_STACKIT
 
   scm_i_pthread_once (&init_thread_key_once, init_thread_key);
 
-  if ((t = SCM_I_CURRENT_THREAD) == NULL)
+  t = SCM_I_CURRENT_THREAD;
+  if (t == NULL)
     {
       /* This thread has not been guilified yet.
        */
--- orig/libguile/threads.h
+++ mod/libguile/threads.h
@@ -177,10 +177,25 @@ SCM_API SCM scm_thread_exited_p (SCM thr
 
 SCM_API void scm_dynwind_critical_section (SCM mutex);
 
+
+/* The current-thread object.  Use thread-local storage if available and
+   `getspecific ()' otherwise.  */
+
+#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
+
+SCM_API SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread;
+#define SCM_I_CURRENT_THREAD (scm_i_current_thread)
+
+#else /* !SCM_HAVE_THREAD_STORAGE_CLASS */
+
 #define SCM_I_CURRENT_THREAD \
   ((scm_i_thread *) scm_i_pthread_getspecific (scm_i_thread_key))
+
+#endif /* SCM_HAVE_THREAD_STORAGE_CLASS */
+
 SCM_API scm_i_pthread_key_t scm_i_thread_key;
 
+
 #define scm_i_dynwinds()         (SCM_I_CURRENT_THREAD->dynwinds)
 #define scm_i_set_dynwinds(w)    (SCM_I_CURRENT_THREAD->dynwinds = (w))
 #define scm_i_last_debug_frame() (SCM_I_CURRENT_THREAD->last_debug_frame)