* __scm.h (SCM_ALLOW_INTS_ONLY): Removed.

(SCM_NONREC_CRITICAL_SECTION_START,
SCM_NONREC_CRITICAL_SECTION_END, SCM_REC_CRITICAL_SECTION_START,
SCM_REC_CRITICAL_SECTION_END): New macros.
(SCM_CRITICAL_SECTION_START/END): Defined here.

* eval.c: Insert SOURCE_SECTION_START / SOURCE_SECTION_END around
the three calls to scm_m_expand_body.

* gc.h: #include "libguile/pthread-threads.h";
(SCM_FREELIST_CREATE, SCM_FREELIST_LOC): New macros.

* gc.c (scm_i_freelist, scm_i_freelist2): Defined to be of type
scm_t_key;

* gc.c, gc-freelist.c, inline.h: Use SCM_FREELIST_LOC for freelist
access.

* gc-freelist.c (scm_gc_init_freelist): Create freelist keys.

* gc-freelist.c, threads.c (really_launch): Use
SCM_FREELIST_CREATE.

* gc-malloc.c (scm_realloc, scm_gc_register_collectable_memory):

* gc.c (scm_i_expensive_validation_check, scm_gc,
scm_gc_for_newcell): Put threads to sleep before doing GC-related
heap administration so that those pieces of code are executed
single-threaded.  We might consider rewriting these code sections
in terms of a "call_gc_code_singly_threaded" construct instead of
calling the pair of scm_i_thread_put_to_sleep () and
scm_i_thread_wake_up ().  Also, we would want to have as many of
these sections eleminated.

* init.c (scm_init_guile_1): Call scm_threads_prehistory.

* inline.h: #include "libguile/threads.h"

* pthread-threads.h: Macros now conform more closely to the
pthreads interface.  Some of them now take a second argument.

* threads.c, threads.h: Many changes.

* configure.in: Temporarily replaced "copt" threads option with new
option "pthreads".
(USE_PTHREAD_THREADS): Define if pthreads configured.

17 files changed, 981 insertions, 483 deletions

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 20d720686..8d96c60bc 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,61 @@
+2002-12-09  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	These changes are the start of support for preemptive
+	multithreading.  Marius and I have agreed that I commit this code
+	into the repository although it isn't thoroughly tested and surely
+	introduces many bugs.  The bugs should only be exposed when using
+	threads, though.  Signalling and error handling for threads is
+	very likely broken.  Work on making the implementation cleaner and
+	more efficient is needed.
+	
+	* __scm.h (SCM_ALLOW_INTS_ONLY): Removed.
+	(SCM_NONREC_CRITICAL_SECTION_START,
+	SCM_NONREC_CRITICAL_SECTION_END, SCM_REC_CRITICAL_SECTION_START,
+	SCM_REC_CRITICAL_SECTION_END): New macros.
+	(SCM_CRITICAL_SECTION_START/END): Defined here.
+
+	* eval.c: Insert SOURCE_SECTION_START / SOURCE_SECTION_END around
+	the three calls to scm_m_expand_body.
+
+	* gc.h: #include "libguile/pthread-threads.h";
+	(SCM_FREELIST_CREATE, SCM_FREELIST_LOC): New macros.
+
+	* gc.c (scm_i_freelist, scm_i_freelist2): Defined to be of type
+	scm_t_key;
+
+	* gc.c, gc-freelist.c, inline.h: Use SCM_FREELIST_LOC for freelist
+	access.
+
+	* gc-freelist.c (scm_gc_init_freelist): Create freelist keys.
+
+	* gc-freelist.c, threads.c (really_launch): Use
+	SCM_FREELIST_CREATE.
+
+	* gc-malloc.c (scm_realloc, scm_gc_register_collectable_memory):
+
+	* gc.c (scm_i_expensive_validation_check, scm_gc,
+	scm_gc_for_newcell): Put threads to sleep before doing GC-related
+	heap administration so that those pieces of code are executed
+	single-threaded.  We might consider rewriting these code sections
+	in terms of a "call_gc_code_singly_threaded" construct instead of
+	calling the pair of scm_i_thread_put_to_sleep () and
+	scm_i_thread_wake_up ().  Also, we would want to have as many of
+	these sections eleminated.
+
+	* init.c (scm_init_guile_1): Call scm_threads_prehistory.
+
+	* inline.h: #include "libguile/threads.h"
+
+	* pthread-threads.h: Macros now conform more closely to the
+	pthreads interface.  Some of them now take a second argument.
+
+	* threads.c, threads.h: Many changes.
+
+2002-12-09  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* Makefile.am (version.h): Changed $^ --> $< in rule for
+	version.h.
+	
 2002-12-08  Rob Browning  <rlb@defaultvalue.org>
 
 	* version.h.in (SCM_MICRO_VERSION): use @--@ substitution now.
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 78121c7fe..e91c320a8 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -181,7 +181,7 @@ EXTRA_DIST = ChangeLog-gh ChangeLog-scm ChangeLog-threads		\
 ## usual @...@, so autoconf doesn't go and substitute the values
 ## directly into the left-hand sides of the sed substitutions.  *sigh*
 version.h: version.h.in
-	sed < $^ > $@.tmp \
+	sed < $< > $@.tmp \
 	  -e s:@-GUILE_MAJOR_VERSION-@:${GUILE_MAJOR_VERSION}: \
 	  -e s:@-GUILE_MINOR_VERSION-@:${GUILE_MINOR_VERSION}: \
 	  -e s:@-GUILE_MICRO_VERSION-@:${GUILE_MICRO_VERSION}:
diff --git a/libguile/__scm.h b/libguile/__scm.h
index bb6a60a34..3cb666398 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -446,53 +446,46 @@ do { \
 #define SCM_FENCE
 #endif
 
-#define SCM_DEFER_INTS \
-do { \
-  SCM_FENCE; \
-  SCM_CHECK_NOT_DISABLED; \
-  SCM_CRITICAL_SECTION_START; \
-  SCM_FENCE; \
-  scm_ints_disabled = 1; \
-  SCM_FENCE; \
+#define SCM_DEFER_INTS				\
+do {						\
+  SCM_FENCE;					\
+  SCM_CHECK_NOT_DISABLED;			\
+  SCM_REC_CRITICAL_SECTION_START (scm_i_defer);	\
+  SCM_FENCE;					\
+  scm_ints_disabled = 1;			\
+  SCM_FENCE;					\
 } while (0)
 
 
-#define SCM_ALLOW_INTS_ONLY \
-do { \
-  SCM_CRITICAL_SECTION_END; \
-  scm_ints_disabled = 0; \
+#define SCM_ALLOW_INTS				\
+do {						\
+  SCM_FENCE;					\
+  SCM_CHECK_NOT_ENABLED;			\
+  SCM_REC_CRITICAL_SECTION_END (scm_i_defer);	\
+  SCM_FENCE;					\
+  scm_ints_disabled = 0;			\
+  SCM_FENCE;					\
+  SCM_THREAD_SWITCHING_CODE;			\
+  SCM_FENCE;					\
 } while (0)
 
 
-#define SCM_ALLOW_INTS \
-do { \
-  SCM_FENCE; \
-  SCM_CHECK_NOT_ENABLED; \
-  SCM_CRITICAL_SECTION_END; \
-  SCM_FENCE; \
-  scm_ints_disabled = 0; \
-  SCM_FENCE; \
-  SCM_THREAD_SWITCHING_CODE; \
-  SCM_FENCE; \
+#define SCM_REDEFER_INTS			\
+do {						\
+  SCM_FENCE;					\
+  SCM_REC_CRITICAL_SECTION_START (scm_i_defer);	\
+  ++scm_ints_disabled;				\
+  SCM_FENCE;					\
 } while (0)
 
 
-#define SCM_REDEFER_INTS  \
-do { \
-  SCM_FENCE; \
-  SCM_CRITICAL_SECTION_START; \
-  ++scm_ints_disabled; \
-  SCM_FENCE; \
-} while (0)
-
-
-#define SCM_REALLOW_INTS \
-do { \
-  SCM_FENCE; \
-  SCM_CRITICAL_SECTION_END; \
-  SCM_FENCE; \
-  --scm_ints_disabled; \
-  SCM_FENCE; \
+#define SCM_REALLOW_INTS			\
+do {						\
+  SCM_FENCE;					\
+  SCM_REC_CRITICAL_SECTION_END (scm_i_defer);	\
+  SCM_FENCE;					\
+  --scm_ints_disabled;				\
+  SCM_FENCE;					\
 } while (0)
 
 
@@ -504,6 +497,65 @@ do { \
 
 
 
+/* Critical sections */
+
+#define SCM_DECLARE_NONREC_CRITICAL_SECTION(prefix) \
+  extern scm_t_mutex prefix ## _mutex
+
+#define SCM_NONREC_CRITICAL_SECTION_START(prefix)	\
+  do { scm_thread *t = scm_i_leave_guile ();		\
+       scm_i_plugin_mutex_lock (&prefix ## _mutex);	\
+       scm_i_enter_guile (t);				\
+  } while (0)
+
+#define SCM_NONREC_CRITICAL_SECTION_END(prefix)		\
+  do { scm_i_plugin_mutex_unlock (&prefix ## _mutex);	\
+  } while (0)
+
+/* This could be replaced by a single call to scm_i_plugin_mutex_lock
+   on systems which support recursive mutecis (like LinuxThreads).
+   We should test for the presence of recursive mutecis in
+   configure.in.
+
+   Also, it is probably possible to replace recursive sections with
+   non-recursive ones, so don't worry about the complexity.
+ */
+   
+#define SCM_DECLARE_REC_CRITICAL_SECTION(prefix)	\
+  extern scm_t_mutex prefix ## _mutex;			\
+  extern int prefix ## _count;				\
+  extern scm_thread *prefix ## _owner
+
+#define SCM_REC_CRITICAL_SECTION_START(prefix)				\
+  do { scm_i_plugin_mutex_lock (&scm_i_section_mutex);			\
+       if (prefix ## _count && prefix ## _owner == SCM_CURRENT_THREAD)	\
+	 {								\
+	   ++prefix ## _count;						\
+           scm_i_plugin_mutex_unlock (&scm_i_section_mutex);		\
+	 }								\
+       else								\
+	 {								\
+	   scm_thread *t = scm_i_leave_guile ();			\
+	   scm_i_plugin_mutex_unlock (&scm_i_section_mutex);		\
+	   scm_i_plugin_mutex_lock (&prefix ## _mutex);			\
+	   prefix ## _count = 1;					\
+	   prefix ## _owner = t;					\
+	   scm_i_enter_guile (t);					\
+	 }								\
+  } while (0)
+
+#define SCM_REC_CRITICAL_SECTION_END(prefix)			\
+  do { scm_i_plugin_mutex_lock (&scm_i_section_mutex);		\
+       if (!--prefix ## _count)					\
+	 {							\
+	   prefix ## _owner = 0;				\
+	   scm_i_plugin_mutex_unlock (&prefix ## _mutex);	\
+	 }							\
+       scm_i_plugin_mutex_unlock (&scm_i_section_mutex);	\
+  } while (0)
+
+/* Note: The following needs updating. */
+
 /* Classification of critical sections
  *
  * When Guile moves to POSIX threads, it won't be possible to prevent
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 42870e787..3d25f1cb5 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -88,7 +88,7 @@
    */
 
 #ifdef HAVE_RESTARTABLE_SYSCALLS
-#ifndef USE_COPT_THREADS /* However, don't assume SA_RESTART 
+#ifndef USE_PTHREAD_THREADS /* However, don't assume SA_RESTART 
 			    works with pthreads... */
 #define SCM_SYSCALL(line) line
 #endif
diff --git a/libguile/eval.c b/libguile/eval.c
index 7bdedd0d3..8ba26f293 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -152,6 +152,10 @@ char *alloca ();
 
 #define EXTEND_ENV SCM_EXTEND_ENV
 
+SCM_REC_CRITICAL_SECTION (source);
+#define SOURCE_SECTION_START SCM_REC_CRITICAL_SECTION_START (source);
+#define SOURCE_SECTION_END SCM_REC_CRITICAL_SECTION_END (source);
+
 SCM *
 scm_ilookup (SCM iloc, SCM env)
 {
@@ -1580,7 +1584,11 @@ scm_eval_body (SCM code, SCM env)
 	{
 	  if (SCM_ISYMP (SCM_CAR (code)))
 	    {
-	      code = scm_m_expand_body (code, env);
+	      SOURCE_SECTION_START;
+	      /* check for race condition */
+	      if (SCM_ISYMP (SCM_CAR (code)))
+		code = scm_m_expand_body (code, env);
+	      SOURCE_SECTION_END;
 	      goto again;
 	    }
 	}
@@ -1979,7 +1987,11 @@ dispatch:
 	    {
 	      if (SCM_ISYMP (form))
 		{
-		  x = scm_m_expand_body (x, env);
+		  SOURCE_SECTION_START;
+		  /* check for race condition */
+		  if (SCM_ISYMP (SCM_CAR (x)))
+		    x = scm_m_expand_body (x, env);
+		  SOURCE_SECTION_END;
 		  goto nontoplevel_begin;
 		}
 	      else
@@ -3634,7 +3646,11 @@ tail:
 	    {
 	      if (SCM_ISYMP (SCM_CAR (proc)))
 		{
-		  proc = scm_m_expand_body (proc, args);
+		  SOURCE_SECTION_START;
+		  /* check for race condition */
+		  if (SCM_ISYMP (SCM_CAR (proc)))
+		    proc = scm_m_expand_body (proc, args);
+		  SOURCE_SECTION_END;
 		  goto again;
 		}
 	      else
diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c
index 1b9780531..8fce129db 100644
--- a/libguile/gc-freelist.c
+++ b/libguile/gc-freelist.c
@@ -168,8 +168,11 @@ scm_gc_init_freelist (void)
   int init_heap_size_2
     = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2);
 
-  scm_i_freelist = SCM_EOL;
-  scm_i_freelist2 = SCM_EOL;
+  /* These are the thread-local freelists. */
+  scm_key_create (&scm_i_freelist, free);
+  scm_key_create (&scm_i_freelist2, free);
+  SCM_FREELIST_CREATE (scm_i_freelist);
+  SCM_FREELIST_CREATE (scm_i_freelist2);
   
   scm_init_freelist (&scm_i_master_freelist2, 2, 
 		     scm_getenv_int ("GUILE_MIN_YIELD_2", SCM_DEFAULT_MIN_YIELD_2));
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index 54a162263..dd7e30432 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -130,15 +130,22 @@ scm_realloc (void *mem, size_t size)
   if (ptr)
     return ptr;
 
+  scm_i_thread_put_to_sleep ();
+  
   scm_i_sweep_all_segments ("realloc");
   
   SCM_SYSCALL (ptr = realloc (mem, size));
   if (ptr)
-    return ptr;
+    { 
+      scm_i_thread_wake_up ();
+      return ptr;
+    }
 
   scm_igc ("realloc");
   scm_i_sweep_all_segments ("realloc");
   
+  scm_i_thread_wake_up ();
+  
   SCM_SYSCALL (ptr = realloc (mem, size));
   if (ptr)
     return ptr;
@@ -208,11 +215,14 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
    */
   if (scm_mallocated > scm_mtrigger)
     {
-      unsigned long prev_alloced  = scm_mallocated;
+      unsigned long prev_alloced;
       float yield;
       
+      scm_i_thread_put_to_sleep ();
+      
+      prev_alloced  = scm_mallocated;
       scm_igc (what);
-      scm_i_sweep_all_segments("mtrigger");
+      scm_i_sweep_all_segments ("mtrigger");
 
       yield = ((float)prev_alloced - (float) scm_mallocated)
 	/ (float) prev_alloced;
@@ -243,6 +253,8 @@ scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 	  fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", scm_mtrigger);
 #endif
 	}
+      
+      scm_i_thread_wake_up ();
     }
   
 #ifdef GUILE_DEBUG_MALLOC
diff --git a/libguile/gc.c b/libguile/gc.c
index 9c5de1d92..6ad9c4ec2 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -144,7 +144,9 @@ scm_i_expensive_validation_check (SCM cell)
       else
 	{
 	  counter = scm_debug_cells_gc_interval;
+	  scm_i_thread_put_to_sleep ();
 	  scm_igc ("scm_assert_cell_valid");
+	  scm_i_thread_wake_up ();
 	}
     }
 }
@@ -249,8 +251,8 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
 
 
 
-SCM scm_i_freelist = SCM_EOL;
-SCM scm_i_freelist2 = SCM_EOL;
+scm_t_key scm_i_freelist;
+scm_t_key scm_i_freelist2;
 
 
 /* scm_mtrigger
@@ -457,7 +459,9 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
 #define FUNC_NAME s_scm_gc
 {
   SCM_DEFER_INTS;
+  scm_i_thread_put_to_sleep ();
   scm_igc ("call");
+  scm_i_thread_wake_up ();
   SCM_ALLOW_INTS;
   return SCM_UNSPECIFIED;
 }
@@ -475,6 +479,8 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
 {
   SCM cell;
  
+  scm_i_thread_put_to_sleep ();
+
   ++scm_ints_disabled;
 
   *free_cells = scm_i_sweep_some_segments (freelist);
@@ -519,6 +525,7 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells)
 
   *free_cells = SCM_FREE_CELL_CDR (cell);
 
+  scm_i_thread_wake_up ();
 
   return cell;
 }
@@ -540,13 +547,17 @@ scm_igc (const char *what)
   fprintf (stderr,"gc reason %s\n", what);
   
   fprintf (stderr,
-	   SCM_NULLP (scm_i_freelist)
+	   SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist))
 	   ? "*"
-	   : (SCM_NULLP (scm_i_freelist2) ? "o" : "m"));
+	   : (SCM_NULLP (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m"));
 #endif
 
   /* During the critical section, only the current thread may run. */
+#if 0 /* MDJ 021207 <djurfeldt@nada.kth.se>
+       Currently, a much larger piece of the GC is single threaded.
+       Can we shrink it again? */
   SCM_CRITICAL_SECTION_START;
+#endif
 
   if (!scm_root || !scm_stack_base || scm_block_gc)
     {
@@ -610,7 +621,9 @@ scm_igc (const char *what)
   scm_c_hook_run (&scm_after_sweep_c_hook, 0);
   gc_end_stats ();
 
+#if 0 /* MDJ 021207 <djurfeldt@nada.kth.se> */
   SCM_CRITICAL_SECTION_END;
+#endif
 
   /*
     See above.
@@ -1011,8 +1024,8 @@ scm_gc_sweep (void)
   
   /* When we move to POSIX threads private freelists should probably
      be GC-protected instead. */
-  scm_i_freelist = SCM_EOL;
-  scm_i_freelist2 = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
 }
 
 #undef FUNC_NAME
diff --git a/libguile/gc.h b/libguile/gc.h
index 6e1fec939..ebb7ff6e9 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -3,7 +3,7 @@
 #ifndef SCM_GC_H
 #define SCM_GC_H
 
-/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002 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
@@ -50,6 +50,12 @@
 
 #include "libguile/hooks.h"
 
+#ifdef USE_PTHREAD_THREADS
+#include "libguile/pthread-threads.h"
+#else
+#include "libguile/null-threads.h"
+#endif
+
 
 
 typedef struct scm_t_cell
@@ -276,13 +282,14 @@ SCM_API size_t scm_default_max_segment_size;
 
 SCM_API size_t scm_max_segment_size;
 
-/*
-  Deprecated scm_freelist, scm_master_freelist.
-  No warning; this is not a user serviceable part.
- */
-extern SCM scm_i_freelist;
+#define SCM_FREELIST_CREATE(key)		\
+  do { SCM *ls = (SCM *) malloc (sizeof (SCM));	\
+       *ls = SCM_EOL; 				\
+       scm_setspecific ((key), ls); } while (0)
+#define SCM_FREELIST_LOC(key) ((SCM *) scm_getspecific (key))
+extern scm_t_key scm_i_freelist;
+extern scm_t_key scm_i_freelist2;
 extern struct scm_t_cell_type_statistics scm_i_master_freelist;
-extern SCM scm_i_freelist2;
 extern struct scm_t_cell_type_statistics scm_i_master_freelist2;
 
 
diff --git a/libguile/init.c b/libguile/init.c
index 0e0115385..076b05cad 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -444,14 +444,15 @@ scm_init_guile_1 (SCM_STACKITEM *base)
 
   scm_ints_disabled = 1;
   scm_block_gc = 1;
-  
+
+  scm_threads_prehistory ();
   scm_ports_prehistory ();
   scm_smob_prehistory ();
   scm_tables_prehistory ();
 #ifdef GUILE_DEBUG_MALLOC
   scm_debug_malloc_prehistory ();
 #endif
-  if (scm_init_storage ())	          /* requires smob_prehistory */
+  if (scm_init_storage ())        /* requires threads and smob_prehistory */
     abort ();
   
   scm_struct_prehistory ();	  /* requires storage */
diff --git a/libguile/inline.h b/libguile/inline.h
index 419c9f0bc..7d5b20dba 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -57,6 +57,7 @@
 
 #include "libguile/pairs.h"
 #include "libguile/gc.h"
+#include "libguile/threads.h"
 
 
 SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
@@ -79,15 +80,23 @@ SCM
 scm_cell (scm_t_bits car, scm_t_bits cdr)
 {
   SCM z;
+  /* We retrieve the SCM pointer only once since the call to
+     SCM_FREELIST_LOC will be slightly expensive when we support
+     preemptive multithreading.  SCM_FREELIST_DOC will then retrieve
+     the thread specific freelist.
+   
+     Until then, SCM_FREELIST_DOC expands to (&scm_i_freelist) and the
+     following code will compile to the same as if we had worked
+     directly on the scm_i_freelist variable.
+   */
+  SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist);
 
-  if (SCM_NULLP (scm_i_freelist))
-    {
-      z = scm_gc_for_newcell (&scm_i_master_freelist, &scm_i_freelist);
-    }
+  if (SCM_NULLP (*freelist))
+    z = scm_gc_for_newcell (&scm_i_master_freelist, freelist);
   else
     {
-      z = scm_i_freelist;
-      scm_i_freelist = SCM_FREE_CELL_CDR (scm_i_freelist);
+      z = *freelist;
+      *freelist = SCM_FREE_CELL_CDR (*freelist);
     }
 
   /*
@@ -136,6 +145,7 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
   SCM_GC_SET_CELL_WORD (z, 1, cdr);
   SCM_GC_SET_CELL_WORD (z, 0, car);
 
+#if 0 /*fixme* Hmm... let's consider this later. */
 #if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) && !defined(USE_COPT_THREADS)
   /* When we are using preemtive threads, we might need to make
      sure that the initial values for the slots are protected until
@@ -144,7 +154,7 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
 #error review me
   scm_remember_upto_here_1 (SCM_PACK (cdr));
 #endif
-
+#endif
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
   if (scm_expensive_debug_cell_accesses_p )
@@ -160,16 +170,14 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 		 scm_t_bits ccr, scm_t_bits cdr)
 {
   SCM z;
+  SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist2);
 
-
-  if (SCM_NULLP (scm_i_freelist2))
-    {
-      z = scm_gc_for_newcell (&scm_i_master_freelist2, &scm_i_freelist2);
-    }
+  if (SCM_NULLP (*freelist))
+    z = scm_gc_for_newcell (&scm_i_master_freelist2, freelist);
   else
     {
-      z = scm_i_freelist2;
-      scm_i_freelist2 = SCM_FREE_CELL_CDR (scm_i_freelist2);
+      z = *freelist;
+      *freelist = SCM_FREE_CELL_CDR (*freelist);
     }
 
   scm_cells_allocated += 2;
@@ -185,6 +193,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
   SCM_GC_SET_CELL_WORD (z, 3, cdr);
   SCM_GC_SET_CELL_WORD (z, 0, car);
 
+#if 0 /*fixme* Hmm... let's consider this later. */
 #if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) && !defined(USE_COPT_THREADS)
   /* When we are using non-cooperating threads, we might need to make
      sure that the initial values for the slots are protected until
@@ -193,6 +202,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 #error review me
   scm_remember_upto_here_3 (SCM_PACK (cbr), SCM_PACK (ccr), SCM_PACK (cdr));
 #endif
+#endif
 
 
 #if (SCM_DEBUG_CELL_ACCESSES == 1)
diff --git a/libguile/null-threads.h b/libguile/null-threads.h
index 40eaa4292..14d40eea2 100644
--- a/libguile/null-threads.h
+++ b/libguile/null-threads.h
@@ -50,6 +50,8 @@
    no new threads can be created.
 */
 
+#error temporarily broken, compile with threads enabled (default option)
+
 /* We can't switch so don't bother trying. 
 */
 #undef  SCM_THREAD_SWITCHING_CODE
diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h
index 5d68677ce..6e7e1d678 100644
--- a/libguile/pthread-threads.h
+++ b/libguile/pthread-threads.h
@@ -46,49 +46,52 @@
 
 
 
-/* The pthreads-threads implementation.  This is a very simple mapping.
+/* The pthreads-threads implementation.  This is a direct mapping.
 */
 
+/* This is an interface between Guile and the pthreads thread package. */
+
 #include <pthread.h>
 
-#define scm_t_thread pthread_t
+/* MDJ 021209 <djurfeldt@nada.kth.se>:
+   The separation of the plugin interface and the low-level C API
+   (currently in threads.h) needs to be completed in a sensible way.
+ */
+
+/* The scm_t_ types are temporarily used both in plugin and low-level API */
+#define scm_t_thread			pthread_t
 
-#define scm_thread_create(th,proc,data) \
-  pthread_create ((th), NULL, (void *(*)(void *))(proc), (data))
+#define scm_i_plugin_thread_create	pthread_create
 
-#define scm_thread_join(th)   pthread_join (th, NULL)
-#define scm_thread_detach(th) pthread_detach (th)
-#define scm_thread_self()     pthread_self ()
+#define scm_i_plugin_thread_join	pthread_join 
+#define scm_i_plugin_thread_detach	pthread_detach 
+#define scm_i_plugin_thread_self	pthread_self 
 
-#define scm_t_mutex pthread_mutex_t
+#define scm_t_mutex			pthread_mutex_t
 
-#define scm_mutex_init(mx)    pthread_mutex_init (mx, NULL)
-#define scm_mutex_destroy(mx) pthread_mutex_destroy (mx)
-#define scm_mutex_lock(mx)    pthread_mutex_lock (mx)
-#define scm_mutex_trylock(mx) pthread_mutex_trylock (mx)
-#define scm_mutex_unlock(mx)  pthread_mutex_unlock (mx)
+#define scm_i_plugin_mutex_init		pthread_mutex_init 
+#define scm_i_plugin_mutex_destroy	pthread_mutex_destroy
+#define scm_i_plugin_mutex_lock		pthread_mutex_lock 
+#define scm_i_plugin_mutex_trylock	pthread_mutex_trylock 
+#define scm_i_plugin_mutex_unlock	pthread_mutex_unlock 
 
-#define scm_t_cond pthread_cond_t
+#define scm_t_cond			pthread_cond_t
 
-#define scm_cond_init(cv)     pthread_cond_init (cv, NULL)
-#define scm_cond_destroy(cv)  pthread_cond_destroy (cv)
-#define scm_cond_wait(cv,mx)  pthread_cond_wait (cv, mx)
-#define scm_cond_timedwait(cv,mx,at) \
-                              pthread_cond_timedwait (cv, mx, at)
-#define scm_cond_signal(cv)   pthread_cond_signal (cv)
-#define scm_cond_broadcast(cv) \
-                              pthread_cond_broadcast (cv)
+#define scm_i_plugin_cond_init		pthread_cond_init 
+#define scm_i_plugin_cond_destroy	pthread_cond_destroy 
+#define scm_i_plugin_cond_wait		pthread_cond_wait 
+#define scm_i_plugin_cond_timedwait	pthread_cond_timedwait 
+#define scm_i_plugin_cond_signal	pthread_cond_signal 
+#define scm_i_plugin_cond_broadcast	pthread_cond_broadcast 
 
-#define scm_t_key pthread_key_t
+#define scm_t_key			pthread_key_t
 
-#define scm_key_create(keyp)  pthread_key_create (keyp, NULL)
-#define scm_key_delete(key)   pthread_key_delete (key)
-#define scm_key_setspecific(key, value) \
-                              pthread_setspecific (key, value)
-#define scm_key_getspecific(key) \
-                              pthread_getspecific (key)
+#define scm_i_plugin_key_create		pthread_key_create 
+#define scm_i_plugin_key_delete		pthread_key_delete 
+#define scm_i_plugin_setspecific	pthread_setspecific 
+#define scm_i_plugin_getspecific	pthread_getspecific 
 
-#define scm_thread_select    select
+#define scm_i_plugin_select		select
 
 #endif  /* SCM_THREADS_NULL_H */
 
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 50565bedd..3b7f1e77f 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -203,6 +203,34 @@ SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_va
 SCM_SNARF_HERE(SCM c_name) \
 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
 
+#define SCM_NONREC_CRITICAL_SECTION(prefix) \
+SCM_SNARF_HERE(static scm_t_mutex prefix ## _mutex) \
+SCM_SNARF_INIT(scm_i_plugin_mutex_init (&prefix ## _mutex, 0))
+
+#define SCM_GLOBAL_NONREC_CRITICAL_SECTION(prefix) \
+SCM_SNARF_HERE(scm_t_mutex prefix ## _mutex) \
+SCM_SNARF_INIT(scm_i_plugin_mutex_init (&prefix ## _mutex, 0))
+
+#define SCM_REC_CRITICAL_SECTION(prefix) \
+SCM_SNARF_HERE(\
+static scm_t_mutex prefix ## _mutex; \
+static int prefix ## _count; \
+static scm_thread *prefix ## _owner\
+)SCM_SNARF_INIT(\
+scm_i_plugin_mutex_init (&prefix ## _mutex, 0)\
+)
+
+#define SCM_GLOBAL_REC_CRITICAL_SECTION(prefix) \
+SCM_SNARF_HERE(\
+scm_t_mutex prefix ## _mutex; \
+int prefix ## _count; \
+scm_thread *prefix ## _owner\
+)SCM_SNARF_INIT(\
+scm_i_plugin_mutex_init (&prefix ## _mutex, 0); \
+prefix ## _count = 0; \
+prefix ## _owner = 0\
+)
+
 #ifdef SCM_MAGIC_SNARF_DOCS
 #undef SCM_ASSERT
 #define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^
diff --git a/libguile/threads.c b/libguile/threads.c
index d36d3bcc7..4e3c9132b 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -114,16 +114,22 @@ dequeue (SCM q)
     }
 }
 
-
 /*** Threads */
 
-typedef struct scm_thread {
+#define THREAD_INITIALIZED_P(t) (t->base != NULL)
+
+struct scm_thread {
   
   /* Blocking.
    */
   scm_t_cond sleep_cond;
   struct scm_thread *next_waiting;
 
+  /* This mutex represents this threads right to access the heap.
+     That right can temporarily be taken away by the GC.  */
+  scm_t_mutex heap_mutex;
+  int clear_freelists_p; /* set if GC was done while thread was asleep */
+  
   scm_root_state *root;
   SCM handle;
   scm_t_thread thread;
@@ -137,7 +143,7 @@ typedef struct scm_thread {
   SCM_STACKITEM *top;
   jmp_buf regs;
 
-} scm_thread;
+};
 
 static SCM
 make_thread (SCM creation_protects)
@@ -150,26 +156,19 @@ make_thread (SCM creation_protects)
   t->result = creation_protects;
   t->base = NULL;
   t->joining_threads = make_queue ();
-  scm_cond_init (&t->sleep_cond);
+  scm_i_plugin_cond_init (&t->sleep_cond, 0);
+  scm_i_plugin_mutex_init (&t->heap_mutex, 0);
+  t->clear_freelists_p = 0;
   t->exited = 0;
   return z;
 }
 
 static void
-init_thread_creator (SCM thread, scm_t_thread th, scm_root_state *r)
+init_thread_creatant (SCM thread,
+		      SCM_STACKITEM *base)
 {
-  scm_thread *t = SCM_THREAD_DATA(thread);
-  t->root = r;
-  t->thread = th;
-#ifdef DEBUG
-  // fprintf (stderr, "%ld created %ld\n", pthread_self (), th);
-#endif
-}
-
-static void
-init_thread_creatant (SCM thread, SCM_STACKITEM *base)
-{
-  scm_thread *t = SCM_THREAD_DATA(thread);
+  scm_thread *t = SCM_THREAD_DATA (thread);
+  t->thread = scm_thread_self ();
   t->base = base;
   t->top = NULL;
 }
@@ -180,7 +179,7 @@ thread_mark (SCM obj)
   scm_thread *t = SCM_THREAD_DATA (obj);
   scm_gc_mark (t->result);
   scm_gc_mark (t->joining_threads);
-  return t->root->handle;
+  return t->root->handle; /* mark root-state of this thread */
 }
 
 static int
@@ -203,160 +202,43 @@ thread_free (SCM obj)
   return 0;
 }
 
-/*** Fair mutexes */
-
-/* C level mutexes (such as POSIX mutexes) are not necessarily fair
-   but since we'd like to use a mutex for scheduling, we build a fair
-   one on top of the C one.
-*/
-
-typedef struct fair_mutex {
-  scm_t_mutex lock;
-  scm_thread *owner;
-  scm_thread *next_waiting, *last_waiting;
-} fair_mutex;
-
-static void
-fair_mutex_init (fair_mutex *m)
-{
-  scm_mutex_init (&m->lock);
-  m->owner = NULL;
-  m->next_waiting = NULL;
-  m->last_waiting = NULL;
-}
-
-static void
-fair_mutex_lock_1 (fair_mutex *m, scm_thread *t)
-{
-  if (m->owner == NULL)
-    m->owner = t;
-  else
-    {
-      t->next_waiting = NULL;
-      if (m->last_waiting)
-	m->last_waiting->next_waiting = t;
-      else
-	m->next_waiting = t;
-      m->last_waiting = t;
-      do
-	{
-	  int err;
-	  err = scm_cond_wait (&t->sleep_cond, &m->lock);
-	  assert (err == 0);
-	}
-      while (m->owner != t);
-      assert (m->next_waiting == t);
-      m->next_waiting = t->next_waiting;
-      if (m->next_waiting == NULL)
-	m->last_waiting = NULL;
-    }
-  scm_mutex_unlock (&m->lock);
-}
-
-static void
-fair_mutex_lock (fair_mutex *m, scm_thread *t)
-{
-  scm_mutex_lock (&m->lock);
-  fair_mutex_lock_1 (m, t);
-}
-
-static void
-fair_mutex_unlock_1 (fair_mutex *m)
-{
-  scm_thread *t;
-  scm_mutex_lock (&m->lock);
-  // fprintf (stderr, "%ld unlocking\n", m->owner->pthread);
-  if ((t = m->next_waiting) != NULL)
-    {
-      m->owner = t;
-      scm_cond_signal (&t->sleep_cond);
-    }
-  else
-    m->owner = NULL;
-  // fprintf (stderr, "%ld unlocked\n", pthread_self ());
-}
-
-static void
-fair_mutex_unlock (fair_mutex *m)
-{
-  fair_mutex_unlock_1 (m);
-  scm_mutex_unlock (&m->lock);
-}
-
-/*  Temporarily give up the mutex.  This function makes sure that we
-    are on the wait queue before starting the next thread.  Otherwise
-    the next thread might preempt us and we will have a hard time
-    getting on the wait queue.
-*/
-static void
-fair_mutex_yield (fair_mutex *m)
-{
-  scm_thread *self = m->owner;
-  fair_mutex_unlock_1 (m);
-  fair_mutex_lock_1 (m, self);
-}
-
-static int
-fair_cond_wait (scm_t_cond *c, fair_mutex *m)
-{
-  scm_thread *t = m->owner;
-  int err;
-  fair_mutex_unlock_1 (m);
-  err = scm_cond_wait (c, &m->lock);
-  fair_mutex_lock_1 (m, t);
-  return err;
-}
-
-static int
-fair_cond_timedwait (scm_t_cond *c, fair_mutex *m, struct timespec *at)
-{
-  int err;
-  scm_thread *t = m->owner;
-  fair_mutex_unlock_1 (m);
-  err = scm_cond_timedwait (c, &m->lock, at);  /* XXX - signals? */
-  fair_mutex_lock_1 (m, t);
-  return err;
-}
-
 /*** Scheduling */
 
-/* When a thread wants to execute Guile functions, it locks the
-   guile_mutex.
-*/
-
-static fair_mutex guile_mutex;
-
-static SCM cur_thread;
-void *scm_i_thread_data;
+#define cur_thread (SCM_CURRENT_THREAD->handle)
+scm_t_key scm_i_thread_key;
+scm_t_key scm_i_root_state_key;
 
 void
 scm_i_set_thread_data (void *data)
 {
-  scm_thread *t = SCM_THREAD_DATA (cur_thread);
-  scm_i_thread_data = data;
+  scm_thread *t = SCM_CURRENT_THREAD;
+  scm_setspecific (scm_i_root_state_key, data);
   t->root = (scm_root_state *)data;
 }
   
 static void
 resume (scm_thread *t)
 {
-  cur_thread = t->handle;
-  scm_i_thread_data = t->root;
   t->top = NULL;
+  if (t->clear_freelists_p)
+    {
+      *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+      *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
+      t->clear_freelists_p = 0;
+    }
 }
 
-static void
-enter_guile (scm_thread *t)
+void
+scm_i_enter_guile (scm_thread *t)
 {
-  fair_mutex_lock (&guile_mutex, t);
+  scm_i_plugin_mutex_lock (&t->heap_mutex);
   resume (t);
 }
 
 static scm_thread *
 suspend ()
 {
-  SCM cur = cur_thread;
-  scm_thread *c = SCM_THREAD_DATA (cur);
+  scm_thread *c = SCM_CURRENT_THREAD;
 
   /* record top of stack for the GC */
   c->top = (SCM_STACKITEM *)&c;
@@ -367,30 +249,12 @@ suspend ()
   return c;
 }
 
-static scm_thread *
-leave_guile ()
+scm_thread *
+scm_i_leave_guile ()
 {
-  scm_thread *c = suspend ();
-  fair_mutex_unlock (&guile_mutex);
-  return c;
-}
-
-int scm_i_switch_counter;
-
-SCM
-scm_yield ()
-{
-  /* Testing guile_mutex.next_waiting without locking guile_mutex.lock
-     is OK since the outcome is not critical.  Even when it changes
-     after the test, we do the right thing.
-  */
-  if (guile_mutex.next_waiting)
-    {
-      scm_thread *t = suspend ();
-      fair_mutex_yield (&guile_mutex);
-      resume (t);
-    }
-  return SCM_BOOL_T;
+  scm_thread *t = suspend ();
+  scm_i_plugin_mutex_unlock (&t->heap_mutex);
+  return t;
 }
 
 /* Put the current thread to sleep until it is explicitely unblocked.
@@ -400,7 +264,7 @@ block ()
 {
   int err;
   scm_thread *t = suspend ();
-  err = fair_cond_wait (&t->sleep_cond, &guile_mutex);
+  err = scm_i_plugin_cond_wait (&t->sleep_cond, &t->heap_mutex);
   resume (t);
   return err;
 }
@@ -410,11 +274,11 @@ block ()
    reached.  Return 0 when it has been unblocked; errno otherwise.
  */
 static int
-timed_block (struct timespec *at)
+timed_block (const struct timespec *at)
 {
   int err;
   scm_thread *t = suspend ();
-  err = fair_cond_timedwait (&t->sleep_cond, &guile_mutex, at);
+  err = scm_i_plugin_cond_timedwait (&t->sleep_cond, &t->heap_mutex, at);
   resume (t);
   return err;
 }
@@ -424,11 +288,12 @@ timed_block (struct timespec *at)
 static void
 unblock (scm_thread *t)
 {
-  scm_cond_signal (&t->sleep_cond);
+  scm_i_plugin_cond_signal (&t->sleep_cond);
 }
 
 /*** Thread creation */
 
+static scm_t_mutex thread_admin_mutex;
 static SCM all_threads;
 static int thread_count;
 
@@ -459,11 +324,17 @@ handler_bootstrip (launch_data* data, SCM tag, SCM throw_args)
 static void
 really_launch (SCM_STACKITEM *base, launch_data *data)
 {
-  SCM thread = data->thread;
-  scm_thread *t = SCM_THREAD_DATA (thread);
-  init_thread_creatant (thread, base);
-  enter_guile (t);
-
+  SCM thread;
+  scm_thread *t;
+  thread = data->thread;
+  t = SCM_THREAD_DATA (thread);
+  SCM_FREELIST_CREATE (scm_i_freelist);
+  SCM_FREELIST_CREATE (scm_i_freelist2);
+  scm_setspecific (scm_i_thread_key, t);
+  scm_setspecific (scm_i_root_state_key, t->root);
+  scm_i_plugin_mutex_lock (&t->heap_mutex); /* ensure that we "own" the heap */
+  init_thread_creatant (thread, base); /* must own the heap */
+  
   data->rootcont = SCM_BOOL_F;
   t->result =
     scm_internal_cwdr ((scm_t_catch_body) body_bootstrip,
@@ -473,16 +344,19 @@ really_launch (SCM_STACKITEM *base, launch_data *data)
   free (data);
 
   scm_thread_detach (t->thread);
-  all_threads = scm_delq (thread, all_threads);
+  scm_i_plugin_mutex_lock (&thread_admin_mutex);
+  all_threads = scm_delq_x (thread, all_threads);
   t->exited = 1;
   thread_count--;
-  leave_guile ();
+  scm_i_plugin_mutex_unlock (&thread_admin_mutex);
+  /* We're leaving with heap_mutex still locked. */
 }
 
-static void
+static void *
 launch_thread (void *p)
 {
   really_launch ((SCM_STACKITEM *)&p, (launch_data *)p);
+  return 0;
 }
 
 static SCM
@@ -500,8 +374,9 @@ create_thread (scm_t_catch_body body, void *body_data,
 
   {
     scm_t_thread th;
-    SCM root, old_winds;
+    SCM root, old_winds, new_threads;
     launch_data *data;
+    scm_thread *t;
     int err;
 
     /* Unwind wind chain. */
@@ -519,15 +394,30 @@ create_thread (scm_t_catch_body body, void *body_data,
     data->body_data = body_data;
     data->handler = handler;
     data->handler_data = handler_data;
-    err = scm_thread_create (&th, launch_thread, (void *) data);
-    if (err == 0)
+    t = SCM_THREAD_DATA (thread);
+    /* must initialize root state pointer before the thread is linked
+       into all_threads */
+    t->root = SCM_ROOT_STATE (root);
+    
+    /* In order to avoid the need of synchronization between parent
+       and child thread, we need to insert the child into all_threads
+       before creation. */
+    new_threads = scm_cons (thread, SCM_BOOL_F); /* could cause GC */
+    scm_i_plugin_mutex_lock (&thread_admin_mutex);
+    SCM_SETCDR (new_threads, all_threads);
+    all_threads = new_threads;
+    thread_count++;
+    scm_i_plugin_mutex_unlock (&thread_admin_mutex);
+    
+    err = scm_i_plugin_thread_create (&th, 0, launch_thread, (void *) data);
+    if (err != 0)
       {
-	init_thread_creator (thread, th, SCM_ROOT_STATE (root));
-	all_threads = scm_cons (thread, all_threads);
-	thread_count++;
+	scm_i_plugin_mutex_lock (&thread_admin_mutex);
+	all_threads = scm_delq_x (thread, all_threads);
+	((scm_thread *) SCM_THREAD_DATA(thread))->exited = 1;
+	thread_count--;
+	scm_i_plugin_mutex_unlock (&thread_admin_mutex);
       }
-    else
-      ((scm_thread *)SCM_THREAD_DATA(thread))->exited = 1;
 
     /* Return to old dynamic context. */
     scm_dowinds (old_winds, - scm_ilength (old_winds));
@@ -564,13 +454,6 @@ SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_spawn_thread (scm_t_catch_body body, void *body_data,
-		  scm_t_catch_handler handler, void *handler_data)
-{
-  return create_thread (body, body_data, handler, handler_data, SCM_BOOL_F);
-}
-
 SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
 	    (SCM thread),
 "Suspend execution of the calling thread until the target @var{thread} "
@@ -587,9 +470,11 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
   t = SCM_THREAD_DATA (thread);
   if (!t->exited)
     {
-      scm_thread *c = leave_guile ();
-      scm_thread_join (t->thread);
-      enter_guile (c);
+      scm_thread *c = scm_i_leave_guile ();
+      while (!THREAD_INITIALIZED_P (t))
+	SCM_TICK;
+      scm_thread_join (t->thread, 0);
+      scm_i_enter_guile (c);
     }
   res = t->result;
   t->result = SCM_BOOL_F;
@@ -597,7 +482,7 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-/*** Mutexes */
+/*** Fair mutexes */
 
 /* We implement our own mutex type since we want them to be 'fair', we
    want to do fancy things while waiting for them (like running
@@ -605,30 +490,34 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
    Also, we might add things that are nice for debugging.
 */
 
-typedef struct scm_mutex {
+typedef struct fair_mutex {
   /* the thread currently owning the mutex, or SCM_BOOL_F. */
+  scm_t_mutex lock;
+  int lockedp;
   SCM owner;
   /* how much the owner owns us. */
   int level;
   /* the threads waiting for this mutex. */
   SCM waiting;
-} scm_mutex;
+} fair_mutex;
 
 static SCM
-mutex_mark (SCM mx)
+fair_mutex_mark (SCM mx)
 {
-  scm_mutex *m = SCM_MUTEX_DATA (mx);
+  fair_mutex *m = SCM_MUTEX_DATA (mx);
   scm_gc_mark (m->owner);
   return m->waiting;
 }
 
-SCM_DEFINE (scm_make_mutex, "make-mutex", 0, 0, 0,
+SCM_DEFINE (scm_make_fair_mutex, "make-fair-mutex", 0, 0, 0,
 	    (void),
-	    "Create a new mutex object. ")
-#define FUNC_NAME s_scm_make_mutex
+	    "Create a new fair mutex object. ")
+#define FUNC_NAME s_scm_make_fair_mutex
 {
-  SCM mx = scm_make_smob (scm_tc16_mutex);
-  scm_mutex *m = SCM_MUTEX_DATA (mx);
+  SCM mx = scm_make_smob (scm_tc16_fair_mutex);
+  fair_mutex *m = SCM_MUTEX_DATA (mx);
+  scm_i_plugin_mutex_init (&m->lock, 0);
+  m->lockedp = 0;
   m->owner = SCM_BOOL_F;
   m->level = 0;
   m->waiting = make_queue ();
@@ -636,19 +525,19 @@ SCM_DEFINE (scm_make_mutex, "make-mutex", 0, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_lock_mutex, "lock-mutex", 1, 0, 0,
-	    (SCM mx),
-"Lock @var{mutex}. If the mutex is already locked, the calling thread "
-"blocks until the mutex becomes available. The function returns when "
-"the calling thread owns the lock on @var{mutex}.  Locking a mutex that "
-"a thread already owns will succeed right away and will not block the "
-"thread.  That is, Guile's mutexes are @emph{recursive}. ")
-#define FUNC_NAME s_scm_lock_mutex
+static int
+fair_mutex_lock (fair_mutex *m)
 {
-  scm_mutex *m;
-  SCM_VALIDATE_MUTEX (1, mx);
-  m = SCM_MUTEX_DATA (mx);
-
+  scm_i_plugin_mutex_lock (&m->lock);
+#if 0
+  /* Need to wait if another thread is just temporarily unlocking.
+     This is happens very seldom and only when the other thread is
+     between scm_mutex_unlock and scm_i_plugin_mutex_lock below. */
+  while (m->lockedp)
+    SCM_TICK;
+    m->lockedp = 1;
+#endif
+  
   if (m->owner == SCM_BOOL_F)
     m->owner = cur_thread;
   else if (m->owner == cur_thread)
@@ -658,63 +547,51 @@ SCM_DEFINE (scm_lock_mutex, "lock-mutex", 1, 0, 0,
       while (1)
 	{
 	  SCM c = enqueue (m->waiting, cur_thread);
-	  int err = block ();
+	  int err;
+	  /* Note: It's important that m->lock is never locked for
+	     any longer amount of time since that could prevent GC */
+	  scm_i_plugin_mutex_unlock (&m->lock);
+	  err = block ();
 	  if (m->owner == cur_thread)
-	    return SCM_BOOL_T;
+	    return 0;
+	  scm_i_plugin_mutex_lock (&m->lock);
 	  remqueue (m->waiting, c);
+	  scm_i_plugin_mutex_unlock (&m->lock);
 	  if (err)
-	    {
-	      errno = err;
-	      scm_syserror (FUNC_NAME);
-	    }
+	    return err;
 	  SCM_ASYNC_TICK;
+	  scm_i_plugin_mutex_lock (&m->lock);
 	}
     }
-  return SCM_BOOL_T;
+  scm_i_plugin_mutex_unlock (&m->lock);
+  return 0;
 }
-#undef FUNC_NAME
 
-SCM_DEFINE (scm_try_mutex, "try-mutex", 1, 0, 0,
-	    (SCM mx),
-"Try to lock @var{mutex}. If the mutex is already locked by someone "
-"else, return @code{#f}.  Else lock the mutex and return @code{#t}. ")
-#define FUNC_NAME s_scm_try_mutex
+static int
+fair_mutex_trylock (fair_mutex *m)
 {
-  scm_mutex *m;
-  SCM_VALIDATE_MUTEX (1, mx);
-  m = SCM_MUTEX_DATA (mx);
-
+  scm_i_plugin_mutex_lock (&m->lock);
   if (m->owner == SCM_BOOL_F)
     m->owner = cur_thread;
   else if (m->owner == cur_thread)
     m->level++;
   else
-    return SCM_BOOL_F;
-  return SCM_BOOL_T;
+    {
+      scm_i_plugin_mutex_unlock (&m->lock);
+      return EBUSY;
+    }
+  scm_i_plugin_mutex_unlock (&m->lock);
+  return 0;
 }
-#undef FUNC_NAME
 
-SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0,
-	    (SCM mx),
-"Unlocks @var{mutex} if the calling thread owns the lock on "
-"@var{mutex}.  Calling unlock-mutex on a mutex not owned by the current "
-"thread results in undefined behaviour. Once a mutex has been unlocked, "
-"one thread blocked on @var{mutex} is awakened and grabs the mutex "
-"lock.  Every call to @code{lock-mutex} by this thread must be matched "
-"with a call to @code{unlock-mutex}.  Only the last call to "
-"@code{unlock-mutex} will actually unlock the mutex. ")
-#define FUNC_NAME s_scm_unlock_mutex
+static int
+fair_mutex_unlock (fair_mutex *m)
 {
-  scm_mutex *m;
-  SCM_VALIDATE_MUTEX (1, mx);
-  m = SCM_MUTEX_DATA (mx);
-
+  scm_i_plugin_mutex_lock (&m->lock);
   if (m->owner != cur_thread)
     {
-      if (m->owner == SCM_BOOL_F)
-	SCM_MISC_ERROR ("mutex not locked", SCM_EOL);
-      else
-	SCM_MISC_ERROR ("mutex not locked by this thread", SCM_EOL);
+      scm_i_plugin_mutex_unlock (&m->lock);
+      return EPERM;
     }
   else if (m->level > 0)
     m->level--;
@@ -725,44 +602,224 @@ SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0,
 	{
 	  m->owner = next;
 	  unblock (SCM_THREAD_DATA (next));
-	  scm_yield ();
 	}
       else
 	m->owner = SCM_BOOL_F;
     }
-  return SCM_BOOL_T;
+  scm_i_plugin_mutex_unlock (&m->lock);
+  return 0;
 }
-#undef FUNC_NAME
 
-/*** Condition variables */
+/*** Fair condition variables */
 
 /* Like mutexes, we implement our own condition variables using the
    primitives above.
 */
 
-/* yeah, we don't need a structure for this, but more things (like a
-   name) will likely follow... */
-
-typedef struct scm_cond {
+typedef struct fair_cond {
+  scm_t_mutex lock;
   /* the threads waiting for this condition. */
   SCM waiting;
-} scm_cond;
+} fair_cond;
 
 static SCM
-cond_mark (SCM cv)
+fair_cond_mark (SCM cv)
 {
-  scm_cond *c = SCM_CONDVAR_DATA (cv);
+  fair_cond *c = SCM_CONDVAR_DATA (cv);
   return c->waiting;
 }
 
+SCM_DEFINE (scm_make_fair_condition_variable, "make-fair-condition-variable", 0, 0, 0,
+	    (void),
+	    "Make a new fair condition variable.")
+#define FUNC_NAME s_scm_make_fair_condition_variable
+{
+  SCM cv = scm_make_smob (scm_tc16_fair_condvar);
+  fair_cond *c = SCM_CONDVAR_DATA (cv);
+  scm_i_plugin_mutex_init (&c->lock, 0);
+  c->waiting = make_queue ();
+  return cv;
+}
+#undef FUNC_NAME
+
+static int
+fair_cond_timedwait (fair_cond *c,
+		     fair_mutex *m,
+		     const struct timespec *waittime)
+{
+  int err;
+  scm_i_plugin_mutex_lock (&c->lock);
+
+  while (1)
+    {
+      enqueue (c->waiting, cur_thread);
+      scm_i_plugin_mutex_unlock (&c->lock);
+      fair_mutex_unlock (m); /*fixme* - not thread safe */
+      if (waittime == NULL)
+	err = block ();
+      else
+	err = timed_block (waittime);
+      fair_mutex_lock (m);
+      if (err)
+	return err;
+      /* XXX - check whether we have been signalled. */
+      break;
+    }
+  return err;
+}
+
+static int
+fair_cond_signal (fair_cond *c)
+{
+  SCM th;
+  scm_i_plugin_mutex_lock (&c->lock);
+  if (!SCM_FALSEP (th = dequeue (c->waiting)))
+    unblock (SCM_THREAD_DATA (th));
+  scm_i_plugin_mutex_unlock (&c->lock);
+  return 0;
+}
+
+static int
+fair_cond_broadcast (fair_cond *c)
+{
+  SCM th;
+  scm_i_plugin_mutex_lock (&c->lock);
+  while (!SCM_FALSEP (th = dequeue (c->waiting)))
+    unblock (SCM_THREAD_DATA (th));
+  scm_i_plugin_mutex_unlock (&c->lock);
+  return 0;
+}
+
+/*** Mutexes */
+
+SCM_DEFINE (scm_make_mutex, "make-mutex", 0, 0, 0,
+	    (void),
+	    "Create a new mutex object. ")
+#define FUNC_NAME s_scm_make_mutex
+{
+  SCM mx = scm_make_smob (scm_tc16_mutex);
+  scm_i_plugin_mutex_init (SCM_MUTEX_DATA (mx), 0);
+  return mx;
+}
+#undef FUNC_NAME
+
+/*fixme* change documentation */
+SCM_DEFINE (scm_lock_mutex, "lock-mutex", 1, 0, 0,
+	    (SCM mx),
+"Lock @var{mutex}. If the mutex is already locked, the calling thread "
+"blocks until the mutex becomes available. The function returns when "
+"the calling thread owns the lock on @var{mutex}.  Locking a mutex that "
+"a thread already owns will succeed right away and will not block the "
+"thread.  That is, Guile's mutexes are @emph{recursive}. ")
+#define FUNC_NAME s_scm_lock_mutex
+{
+  int err;
+  SCM_VALIDATE_MUTEX (1, mx);
+  
+  if (SCM_TYP16 (mx) == scm_tc16_fair_mutex)
+    err = fair_mutex_lock (SCM_MUTEX_DATA (mx));
+  else
+    {
+      scm_t_mutex *m = SCM_MUTEX_DATA (mx);
+      scm_thread *t = scm_i_leave_guile ();
+      err = scm_i_plugin_mutex_lock (m);
+      scm_i_enter_guile (t);
+    }
+
+  if (err)
+    {
+      errno = err;
+      SCM_SYSERROR;
+    }
+  return SCM_BOOL_T;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_try_mutex, "try-mutex", 1, 0, 0,
+	    (SCM mx),
+"Try to lock @var{mutex}. If the mutex is already locked by someone "
+"else, return @code{#f}.  Else lock the mutex and return @code{#t}. ")
+#define FUNC_NAME s_scm_try_mutex
+{
+  int err;
+  SCM_VALIDATE_MUTEX (1, mx);
+  
+  if (SCM_TYP16 (mx) == scm_tc16_fair_mutex)
+    err = fair_mutex_trylock (SCM_MUTEX_DATA (mx));
+  else
+    {
+      scm_t_mutex *m = SCM_MUTEX_DATA (mx);
+      scm_thread *t = scm_i_leave_guile ();
+      err = scm_i_plugin_mutex_trylock (m);
+      scm_i_enter_guile (t);
+    }
+
+  if (err == EBUSY)
+    return SCM_BOOL_F;
+  
+  if (err)
+    {
+      errno = err;
+      SCM_SYSERROR;
+    }
+  
+  return SCM_BOOL_T;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0,
+	    (SCM mx),
+"Unlocks @var{mutex} if the calling thread owns the lock on "
+"@var{mutex}.  Calling unlock-mutex on a mutex not owned by the current "
+"thread results in undefined behaviour. Once a mutex has been unlocked, "
+"one thread blocked on @var{mutex} is awakened and grabs the mutex "
+"lock.  Every call to @code{lock-mutex} by this thread must be matched "
+"with a call to @code{unlock-mutex}.  Only the last call to "
+"@code{unlock-mutex} will actually unlock the mutex. ")
+#define FUNC_NAME s_scm_unlock_mutex
+{
+  int err;
+  SCM_VALIDATE_MUTEX (1, mx);
+  
+  if (SCM_TYP16 (mx) == scm_tc16_fair_mutex)
+    {
+      err = fair_mutex_unlock (SCM_MUTEX_DATA (mx));
+      if (err == EPERM)
+	{
+	  fair_mutex *m = SCM_MUTEX_DATA (mx);
+	  if (m->owner != cur_thread)
+	    {
+	      if (m->owner == SCM_BOOL_F)
+		SCM_MISC_ERROR ("mutex not locked", SCM_EOL);
+	      else
+		SCM_MISC_ERROR ("mutex not locked by this thread", SCM_EOL);
+	    }
+	}
+    }
+  else
+    {
+      scm_t_mutex *m = SCM_MUTEX_DATA (mx);
+      err = scm_i_plugin_mutex_unlock (m);
+    }
+
+  if (err)
+    {
+      errno = err;
+      SCM_SYSERROR;
+    }
+  return SCM_BOOL_T;
+}
+#undef FUNC_NAME
+
+/*** Condition variables */
+
 SCM_DEFINE (scm_make_condition_variable, "make-condition-variable", 0, 0, 0,
 	    (void),
 	    "Make a new condition variable.")
 #define FUNC_NAME s_scm_make_condition_variable
 {
   SCM cv = scm_make_smob (scm_tc16_condvar);
-  scm_cond *c = SCM_CONDVAR_DATA (cv);
-  c->waiting = make_queue ();
+  scm_i_plugin_cond_init (SCM_CONDVAR_DATA (cv), 0);
   return cv;
 }
 #undef FUNC_NAME
@@ -780,19 +837,24 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
 "is returned. ")
 #define FUNC_NAME s_scm_timed_wait_condition_variable
 {
-  scm_cond *c;
   struct timespec waittime;
   int err;
 
   SCM_VALIDATE_CONDVAR (1, cv);
   SCM_VALIDATE_MUTEX (2, mx);
-
+  if (!((SCM_TYP16 (cv) == scm_tc16_condvar
+	 && SCM_TYP16 (mx) == scm_tc16_mutex)
+	|| (SCM_TYP16 (cv) == scm_tc16_fair_condvar
+	    && SCM_TYP16 (mx) == scm_tc16_fair_mutex)))
+    SCM_MISC_ERROR ("Condition variable and mutex are of different kinds.",
+		    SCM_EOL);
+  
   if (!SCM_UNBNDP (t))
     {
       if (SCM_CONSP (t))
 	{
-	  SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
-	  SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec);
+	  SCM_VALIDATE_UINT_COPY (3, SCM_CAR (t), waittime.tv_sec);
+	  SCM_VALIDATE_UINT_COPY (3, SCM_CDR (t), waittime.tv_nsec);
 	  waittime.tv_nsec *= 1000;
 	}
       else
@@ -802,48 +864,41 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
 	}
     }
 
-  c = SCM_CONDVAR_DATA (cv);
+  if (SCM_TYP16 (cv) == scm_tc16_fair_condvar)
+    err = fair_cond_timedwait (SCM_CONDVAR_DATA (cv),
+			       SCM_MUTEX_DATA (mx),
+			       SCM_UNBNDP (t) ? NULL : &waittime);
+  else
+    {
+      scm_t_cond *c = SCM_CONDVAR_DATA (cv);
+      scm_t_mutex *m = SCM_MUTEX_DATA (mx);
+      scm_thread *t = scm_i_leave_guile ();
+      err = scm_i_plugin_cond_wait (c, m);
+      scm_i_enter_guile (t);
+    }
 
-  while (1)
+  if (err)
     {
-      enqueue (c->waiting, cur_thread);
-      scm_unlock_mutex (mx);
-      if (SCM_UNBNDP (t))
-	err = block ();
-      else
-	err = timed_block (&waittime);
-      scm_lock_mutex (mx);
-      if (err)
-	{
-	  errno = err;
-	  scm_syserror (FUNC_NAME);
-	}
-      /* XXX - check whether we have been signalled. */
-      break;
+      errno = err;
+      SCM_SYSERROR;
     }
-  return SCM_BOOL (err == 0);
+  return SCM_BOOL_T;
 }
 #undef FUNC_NAME
 
-SCM
-scm_wait_condition_variable (SCM c, SCM m)
-{
-  return scm_timed_wait_condition_variable (c, m, SCM_UNDEFINED);
-}
-
 SCM_DEFINE (scm_signal_condition_variable, "signal-condition-variable", 1, 0, 0,
 	    (SCM cv),
 	    "Wake up one thread that is waiting for @var{cv}")
 #define FUNC_NAME s_scm_signal_condition_variable
 {
-  SCM th;
-  scm_cond *c;
-
   SCM_VALIDATE_CONDVAR (1, cv);
-
-  c = SCM_CONDVAR_DATA (cv);
-  if (!SCM_FALSEP (th = dequeue (c->waiting)))
-    unblock (SCM_THREAD_DATA (th));
+  if (SCM_TYP16 (cv) == scm_tc16_fair_condvar)
+    fair_cond_signal (SCM_CONDVAR_DATA (cv));
+  else
+    {
+      scm_t_cond *c = SCM_CONDVAR_DATA (cv);
+      scm_i_plugin_cond_signal (c);
+    }
   return SCM_BOOL_T;
 }
 #undef FUNC_NAME
@@ -853,14 +908,14 @@ SCM_DEFINE (scm_broadcast_condition_variable, "broadcast-condition-variable", 1,
 	    "Wake up all threads that are waiting for @var{cv}. ")
 #define FUNC_NAME s_scm_broadcast_condition_variable
 {
-  SCM th;
-  scm_cond *c;
-
   SCM_VALIDATE_CONDVAR (1, cv);
-
-  c = SCM_CONDVAR_DATA (cv);
-  while (!SCM_FALSEP (th = dequeue (c->waiting)))
-    unblock (SCM_THREAD_DATA (th));
+  if (SCM_TYP16 (cv) == scm_tc16_fair_condvar)
+    fair_cond_broadcast (SCM_CONDVAR_DATA (cv));
+  else
+    {
+      scm_t_cond *c = SCM_CONDVAR_DATA (cv);
+      scm_i_plugin_cond_broadcast (c);
+    }
   return SCM_BOOL_T;
 }
 #undef FUNC_NAME
@@ -892,19 +947,24 @@ scm_threads_mark_stacks (void)
   for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c))
     {
       scm_thread *t = SCM_THREAD_DATA (SCM_CAR (c));
-      if (t->base == NULL)
+      if (!THREAD_INITIALIZED_P (t))
 	{
 	  /* Not fully initialized yet. */
 	  continue;
 	}
       if (t->top == NULL)
 	{
+	  long stack_len;
+#ifdef SCM_DEBUG
+	  if (t->thread != scm_thread_self ())
+	    abort ();
+#endif
 	  /* Active thread */
 	  /* stack_len is long rather than sizet in order to guarantee
 	     that &stack_len is long aligned */
 #ifdef STACK_GROWS_UP
-	  long stack_len = ((SCM_STACKITEM *) (&t) -
-			    (SCM_STACKITEM *) thread->base);
+	  stack_len = ((SCM_STACKITEM *) (&t) -
+		       (SCM_STACKITEM *) thread->base);
 	  
 	  /* Protect from the C stack.  This must be the first marking
 	   * done because it provides information about what objects
@@ -924,8 +984,8 @@ scm_threads_mark_stacks (void)
 	  scm_mark_locations (((size_t) t->base,
 			       (sizet) stack_len));
 #else
-	  long stack_len = ((SCM_STACKITEM *) t->base -
-			    (SCM_STACKITEM *) (&t));
+	  stack_len = ((SCM_STACKITEM *) t->base -
+		       (SCM_STACKITEM *) (&t));
 	  
 	  /* Protect from the C stack.  This must be the first marking
 	   * done because it provides information about what objects
@@ -973,15 +1033,65 @@ scm_internal_select (int nfds,
 		     struct timeval *timeout)
 {
   int res, eno;
-  scm_thread *c = leave_guile ();
-  res = scm_thread_select (nfds, readfds, writefds, exceptfds, timeout);
+  scm_thread *c = scm_i_leave_guile ();
+  res = scm_i_plugin_select (nfds, readfds, writefds, exceptfds, timeout);
   eno = errno;
-  enter_guile (c);
+  scm_i_enter_guile (c);
   SCM_ASYNC_TICK;
   errno = eno;
   return res;
 }
 
+/* Low-level C API */
+
+SCM
+scm_spawn_thread (scm_t_catch_body body, void *body_data,
+		  scm_t_catch_handler handler, void *handler_data)
+{
+  return create_thread (body, body_data, handler, handler_data, SCM_BOOL_F);
+}
+
+#if 0
+int
+scm_mutex_lock (scm_t_mutex *m)
+{
+  scm_thread *t = scm_i_leave_guile ();
+  int res = scm_i_plugin_mutex_lock (m);
+  scm_i_enter_guile (t);
+  return res;
+}
+
+int
+scm_cond_wait (scm_t_cond *c, scm_t_mutex *m)
+{
+  scm_thread *t = scm_i_leave_guile ();
+  scm_i_plugin_cond_wait (c, m);
+  scm_i_enter_guile (t);
+  return 0;
+}
+
+int
+scm_cond_timedwait (scm_t_cond *c, scm_t_mutex *m)
+{
+  scm_thread *t = scm_i_leave_guile ();
+  int res = scm_i_plugin_cond_timedwait (c, m);
+  scm_i_enter_guile (t);
+  return res;
+}
+#endif
+
+void
+scm_enter_guile ()
+{
+  scm_i_enter_guile (SCM_CURRENT_THREAD);
+}
+
+void
+scm_leave_guile ()
+{
+  scm_i_leave_guile ();
+}
+
 unsigned long
 scm_thread_usleep (unsigned long usecs)
 {
@@ -1016,7 +1126,7 @@ SCM_DEFINE (scm_current_thread, "current-thread", 0, 0, 0,
 SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
 	    (void),
 	    "Return a list of all threads.")
-#define FUNC_NAME s_all_threads
+#define FUNC_NAME s_scm_all_threads
 {
   return all_threads;
 }
@@ -1025,7 +1135,7 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
 scm_root_state *
 scm_i_thread_root (SCM thread)
 {
-  return ((scm_thread *)SCM_THREAD_DATA (thread))->root;
+  return ((scm_thread *) SCM_THREAD_DATA (thread))->root;
 }
 
 SCM_DEFINE (scm_thread_exited_p, "thread-exited?", 1, 0, 0,
@@ -1048,41 +1158,135 @@ scm_c_thread_exited_p (SCM thread)
 }
 #undef FUNC_NAME
 
+static scm_t_cond wake_up_cond;
+int scm_i_thread_go_to_sleep;
+static scm_thread *gc_thread;
+static scm_t_mutex gc_section_mutex;
+static scm_thread *gc_section_owner;
+static int gc_section_count = 0;
+static int threads_initialized_p = 0;
+
+void
+scm_i_thread_put_to_sleep ()
+{
+  SCM_REC_CRITICAL_SECTION_START (gc_section);
+  if (threads_initialized_p && gc_section_count == 1)
+    {
+      SCM threads = all_threads;
+      /* Signal all threads to go to sleep */
+      scm_i_thread_go_to_sleep = 1;
+      for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
+	if (SCM_CAR (threads) != cur_thread)
+	  {
+	    scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
+	    t->clear_freelists_p = 1;
+	    scm_i_plugin_mutex_lock (&t->heap_mutex);
+	  }
+      gc_thread = suspend ();
+      scm_i_thread_go_to_sleep = 0;
+    }
+}
+
+void
+scm_i_thread_wake_up ()
+{
+  if (threads_initialized_p && gc_section_count == 1)
+    {
+      SCM threads = all_threads;
+      resume (gc_thread);
+      scm_i_plugin_cond_broadcast (&wake_up_cond);
+      for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
+	if (SCM_CAR (threads) != cur_thread)
+	  {
+	    scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
+	    scm_i_plugin_mutex_unlock (&t->heap_mutex);
+	  }
+    }
+  SCM_REC_CRITICAL_SECTION_END (gc_section);
+}
+
+void
+scm_i_thread_sleep_for_gc ()
+{
+  scm_thread *t;
+  t = suspend ();
+  *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL;
+  *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL;
+  scm_i_plugin_cond_wait (&wake_up_cond, &t->heap_mutex);
+  t->clear_freelists_p = 0;
+  t->top = NULL; /* resume (t); but don't clear freelists */
+}
+
+/* The mother of all recursive critical sections */
+scm_t_mutex scm_i_section_mutex;
+
+scm_t_mutex scm_i_critical_section_mutex;
+scm_t_mutex scm_i_defer_mutex;
+int scm_i_defer_count = 0;
+scm_thread *scm_i_defer_owner = 0;
+
 /*** Initialization */
 
+void
+scm_threads_prehistory ()
+{
+  scm_thread *t;
+  scm_i_plugin_mutex_init (&thread_admin_mutex, 0);
+  scm_i_plugin_mutex_init (&gc_section_mutex, 0);
+  scm_i_plugin_cond_init (&wake_up_cond, 0);
+  scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, 0);
+  thread_count = 1;
+  scm_i_plugin_key_create (&scm_i_thread_key, 0);
+  scm_i_plugin_key_create (&scm_i_root_state_key, 0);
+  scm_i_plugin_mutex_init (&scm_i_defer_mutex, 0);
+  scm_i_plugin_mutex_init (&scm_i_section_mutex, 0);
+  /* Allocate a fake thread object to be used during bootup. */
+  t = malloc (sizeof (scm_thread));
+  t->base = NULL;
+  t->clear_freelists_p = 0;
+  scm_setspecific (scm_i_thread_key, t);
+}
+
 scm_t_bits scm_tc16_thread;
 scm_t_bits scm_tc16_mutex;
+scm_t_bits scm_tc16_fair_mutex;
 scm_t_bits scm_tc16_condvar;
+scm_t_bits scm_tc16_fair_condvar;
 
 void
 scm_init_threads (SCM_STACKITEM *base)
 {
+  SCM thread;
   scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_thread));
-  scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_mutex));
+  scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_t_mutex));
+  scm_tc16_fair_mutex = scm_make_smob_type ("fair-mutex",
+					    sizeof (fair_mutex));
   scm_tc16_condvar = scm_make_smob_type ("condition-variable",
-					 sizeof (scm_cond));
-
-  scm_i_switch_counter = SCM_I_THREAD_SWITCH_COUNT;
+					 sizeof (scm_t_cond));
+  scm_tc16_fair_condvar = scm_make_smob_type ("fair-condition-variable",
+					      sizeof (fair_cond));
 
-  fair_mutex_init (&guile_mutex);
+  thread = make_thread (SCM_BOOL_F);
+  /* Replace initial fake thread with a real thread object */
+  free (SCM_CURRENT_THREAD);
+  scm_setspecific (scm_i_thread_key, SCM_THREAD_DATA (thread));
+  scm_i_enter_guile (SCM_CURRENT_THREAD);
 
-  cur_thread = make_thread (SCM_BOOL_F);
-  enter_guile (SCM_THREAD_DATA (cur_thread));
   /* root is set later from init.c */
-  init_thread_creator (cur_thread, scm_thread_self(), NULL);
-  init_thread_creatant (cur_thread, base);
-
+  init_thread_creatant (thread, base);
   thread_count = 1;
   scm_gc_register_root (&all_threads);
-  all_threads = scm_cons (cur_thread, SCM_EOL);
+  all_threads = scm_cons (thread, SCM_EOL);
 
   scm_set_smob_mark (scm_tc16_thread, thread_mark);
   scm_set_smob_print (scm_tc16_thread, thread_print);
   scm_set_smob_free (scm_tc16_thread, thread_free);
 
-  scm_set_smob_mark (scm_tc16_mutex, mutex_mark);
+  scm_set_smob_mark (scm_tc16_fair_mutex, fair_mutex_mark);
+
+  scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark);
 
-  scm_set_smob_mark (scm_tc16_condvar, cond_mark);
+  threads_initialized_p = 1;
 }
 
 void
@@ -1103,4 +1307,3 @@ scm_init_iselect ()
   c-file-style: "gnu"
   End:
 */
-
diff --git a/libguile/threads.h b/libguile/threads.h
index df83f75c8..a3bdb2d91 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -56,72 +56,152 @@
 /* smob tags for the thread datatypes */
 SCM_API scm_t_bits scm_tc16_thread;
 SCM_API scm_t_bits scm_tc16_mutex;
+SCM_API scm_t_bits scm_tc16_fair_mutex;
 SCM_API scm_t_bits scm_tc16_condvar;
+SCM_API scm_t_bits scm_tc16_fair_condvar;
 
-#define SCM_THREADP(x)      SCM_TYP16_PREDICATE (scm_tc16_thread, x)
-#define SCM_THREAD_DATA(x)  ((void *) SCM_CELL_WORD_1 (x))
+#define SCM_THREADP(x)        SCM_TYP16_PREDICATE (scm_tc16_thread, x)
+#define SCM_THREAD_DATA(x)    ((scm_thread *) SCM_CELL_WORD_1 (x))
 
-#define SCM_MUTEXP(x)       SCM_TYP16_PREDICATE (scm_tc16_mutex, x)
-#define SCM_MUTEX_DATA(x)   ((void *) SCM_CELL_WORD_1 (x))
+#define SCM_MUTEXP(x)         SCM_TYP16_PREDICATE (scm_tc16_mutex, x)
+#define SCM_FAIR_MUTEX_P(x)   SCM_TYP16_PREDICATE (scm_tc16_fair_mutex, x)
+#define SCM_MUTEX_DATA(x)     ((void *) SCM_CELL_WORD_1 (x))
 
-#define SCM_CONDVARP(x)     SCM_TYP16_PREDICATE (scm_tc16_condvar, x)
-#define SCM_CONDVAR_DATA(x) ((void *) SCM_CELL_WORD_1 (x))
+#define SCM_CONDVARP(x)       SCM_TYP16_PREDICATE (scm_tc16_condvar, x)
+#define SCM_FAIR_CONDVAR_P(x) SCM_TYP16_PREDICATE (scm_tc16_fair_condvar, x)
+#define SCM_CONDVAR_DATA(x)   ((void *) SCM_CELL_WORD_1 (x))
 
 #define SCM_VALIDATE_THREAD(pos, a) \
  SCM_MAKE_VALIDATE_MSG (pos, a, THREADP, "thread")
 
 #define SCM_VALIDATE_MUTEX(pos, a) \
- SCM_MAKE_VALIDATE_MSG (pos, a, MUTEXP, "mutex")
+ SCM_ASSERT_TYPE (SCM_MUTEXP (a) || SCM_FAIR_MUTEX_P (a), \
+                  a, pos, FUNC_NAME, "mutex");
 
 #define SCM_VALIDATE_CONDVAR(pos, a) \
- SCM_MAKE_VALIDATE_MSG (pos, a, CONDVARP, "condition variable")
+ SCM_ASSERT_TYPE (SCM_CONDVARP (a) || SCM_FAIR_CONDVAR_P (a), \
+                  a, pos, FUNC_NAME, "condition variable");
 
 SCM_API void scm_threads_mark_stacks (void);
 SCM_API void scm_init_threads (SCM_STACKITEM *);
 SCM_API void scm_init_thread_procs (void);
 
+/*----------------------------------------------------------------------*/
+/* Low-level C API */
+
+/* The purpose of this API is seamless, simple and thread package
+   independent interaction with Guile threads from the application.
+ */
+
+/* MDJ 021209 <djurfeldt@nada.kth.se>:
+   The separation of the plugin interface (currently in
+   pthread-threads.h and null-threads.h) and the low-level C API needs
+   to be completed in a sensible way.
+ */
+
+/* Deprecate this name and rename to scm_thread_create?
+   Introduce the other two arguments in pthread_create to prepare for
+   the future?
+ */
 SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data,
 			      scm_t_catch_handler handler, void *handler_data);
 
+#define scm_thread_join		scm_i_plugin_thread_join
+#define scm_thread_detach	scm_i_plugin_thread_detach
+#define scm_thread_self		scm_i_plugin_thread_self
+
+#define scm_mutex_init		scm_i_plugin_mutex_init 
+#define scm_mutex_destroy	scm_i_plugin_mutex_destroy
+SCM_API int scm_mutex_lock (scm_t_mutex *m);
+#define scm_mutex_trylock	scm_i_plugin_mutex_trylock 
+#define scm_mutex_unlock	scm_i_plugin_mutex_unlock 
+
+#define scm_cond_init		scm_i_plugin_cond_init 
+#define scm_cond_destroy	scm_i_plugin_cond_destroy 
+SCM_API int scm_cond_wait (scm_t_cond *c, scm_t_mutex *m);
+SCM_API int scm_cond_timedwait (scm_t_cond *c,
+				scm_t_mutex *m,
+				const struct timespec *t);
+#define scm_cond_signal		scm_i_plugin_cond_signal 
+#define scm_cond_broadcast	scm_i_plugin_cond_broadcast 
+
+#define scm_key_create		scm_i_plugin_key_create 
+#define scm_key_delete		scm_i_plugin_key_delete 
+#define scm_setspecific		scm_i_plugin_setspecific 
+#define scm_getspecific		scm_i_plugin_getspecific 
+
+#define scm_thread_select	scm_internal_select
+
+/* The application must scm_leave_guile() before entering any piece of
+   code which can
+   1. block, or
+   2. execute for any longer period of time without calling SCM_TICK
+
+   Note, though, that it is *not* necessary to use these calls
+   together with any call in this API.
+ */
+
+SCM_API void scm_enter_guile (void);
+SCM_API void scm_leave_guile (void);
+
+/* Better versions (although we need the former ones also in order to
+   avoid forcing code restructuring in existing applications): */
+/*fixme* Not implemented yet! */
+SCM_API void *scm_in_guile (void (*func) (void*), void *data);
+SCM_API void *scm_outside_guile (void (*func) (void*), void *data);
+
 /* These are versions of the ordinary sleep and usleep functions
    that play nicely with the thread system.  */
 SCM_API unsigned long scm_thread_sleep (unsigned long);
 SCM_API unsigned long scm_thread_usleep (unsigned long);
 
+/* End of low-level C API */
+/*----------------------------------------------------------------------*/
+
+typedef struct scm_thread scm_thread;
+
+SCM_API void scm_i_enter_guile (scm_thread *t);
+SCM_API scm_thread *scm_i_leave_guile (void);
+
 /* Critical sections */
 
-/* Since only one thread can be active anyway, we don't need to do
-   anything special around critical sections.  In fact, that's the
-   reason we do only support cooperative threading: Guile's critical
-   regions have not been completely identified yet.  (I think.) */
+SCM_API scm_t_mutex scm_i_section_mutex;
+
+/* This is the generic critical section for places where we are too
+   lazy to allocate a specific mutex. */
+SCM_DECLARE_NONREC_CRITICAL_SECTION (scm_i_critical_section);
+#define SCM_CRITICAL_SECTION_START \
+  SCM_NONREC_CRITICAL_SECTION_START (scm_i_critical_section)
+#define SCM_CRITICAL_SECTION_END \
+  SCM_NONREC_CRITICAL_SECTION_END (scm_i_critical_section)
 
-#define SCM_CRITICAL_SECTION_START 
-#define SCM_CRITICAL_SECTION_END 
+/* This is the temporary support for the old ALLOW/DEFER ints sections */
+SCM_DECLARE_REC_CRITICAL_SECTION (scm_i_defer);
 
-/* Switching */
+extern int scm_i_thread_go_to_sleep;
 
-SCM_API int scm_i_switch_counter;
-#define SCM_I_THREAD_SWITCH_COUNT 50
+void scm_i_thread_put_to_sleep (void);
+void scm_i_thread_wake_up (void);
+void scm_i_thread_sleep_for_gc (void);
+void scm_threads_prehistory (void);
+void scm_threads_init_first_thread (void);
 
 #define SCM_THREAD_SWITCHING_CODE \
 do { \
-  scm_i_switch_counter--; \
-  if (scm_i_switch_counter == 0) \
-    { \
-      scm_i_switch_counter = SCM_I_THREAD_SWITCH_COUNT; \
-      scm_yield(); \
-    } \
+  if (scm_i_thread_go_to_sleep) \
+    scm_i_thread_sleep_for_gc (); \
 } while (0)
 
 /* The C versions of the Scheme-visible thread functions.  */
-SCM_API SCM scm_yield (void);
 SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
 SCM_API SCM scm_join_thread (SCM t);
 SCM_API SCM scm_make_mutex (void);
+SCM_API SCM scm_make_fair_mutex (void);
 SCM_API SCM scm_lock_mutex (SCM m);
 SCM_API SCM scm_try_mutex (SCM m);
 SCM_API SCM scm_unlock_mutex (SCM m);
 SCM_API SCM scm_make_condition_variable (void);
+SCM_API SCM scm_make_fair_condition_variable (void);
 SCM_API SCM scm_wait_condition_variable (SCM cond, SCM mutex);
 SCM_API SCM scm_timed_wait_condition_variable (SCM cond, SCM mutex,
 					       SCM abstime);
@@ -136,10 +216,16 @@ SCM_API SCM scm_thread_exited_p (SCM thread);
 
 SCM_API scm_root_state *scm_i_thread_root (SCM thread);
 
-SCM_API void *scm_i_thread_data;
-SCM_API void scm_i_set_thread_data (void *);
-#define SCM_THREAD_LOCAL_DATA        scm_i_thread_data
+#define SCM_CURRENT_THREAD \
+  ((scm_thread *) scm_i_plugin_getspecific (scm_i_thread_key))
+extern scm_t_key scm_i_thread_key;
+
+/* These macros have confusing names.
+   They really refer to the root state of the running thread. */
+#define SCM_THREAD_LOCAL_DATA (scm_i_plugin_getspecific (scm_i_root_state_key))
 #define SCM_SET_THREAD_LOCAL_DATA(x) scm_i_set_thread_data(x)
+extern scm_t_key scm_i_root_state_key;
+SCM_API void scm_i_set_thread_data (void *);
 
 #ifndef HAVE_STRUCT_TIMESPEC
 /* POSIX.4 structure for a time value.  This is like a `struct timeval' but
@@ -151,7 +237,7 @@ struct timespec
 };
 #endif
 
-#ifdef USE_COPT_THREADS
+#ifdef USE_PTHREAD_THREADS
 #include "libguile/pthread-threads.h"
 #else
 #include "libguile/null-threads.h"
diff --git a/libguile/version.c b/libguile/version.c
index cd973e8be..5e53b46f9 100644
--- a/libguile/version.c
+++ b/libguile/version.c
@@ -59,7 +59,7 @@ SCM_DEFINE (scm_major_version, "major-version", 0, 0, 0,
             "E.g., the 1 in \"1.6.5\".")
 #define FUNC_NAME s_scm_major_version
 {
-  return scm_number_to_string (SCM_MAKINUM(SCM_MAJOR_VERSION),
+  return scm_number_to_string (SCM_MAKINUM(1),
                                SCM_MAKINUM(10));
 }
 #undef FUNC_NAME
@@ -72,7 +72,7 @@ SCM_DEFINE (scm_minor_version, "minor-version", 0, 0, 0,
             "E.g., the 6 in \"1.6.5\".")
 #define FUNC_NAME s_scm_minor_version
 {
-  return scm_number_to_string (SCM_MAKINUM(SCM_MINOR_VERSION),
+  return scm_number_to_string (SCM_MAKINUM(7),
                                SCM_MAKINUM(10));
 }
 #undef FUNC_NAME
@@ -85,7 +85,7 @@ SCM_DEFINE (scm_micro_version, "micro-version", 0, 0, 0,
             "E.g., the 5 in \"1.6.5\".")
 #define FUNC_NAME s_scm_micro_version
 {
-  return scm_number_to_string (SCM_MAKINUM(SCM_MICRO_VERSION),
+  return scm_number_to_string (SCM_MAKINUM(0),
                                SCM_MAKINUM(10));
 }
 #undef FUNC_NAME
@@ -110,15 +110,17 @@ SCM_DEFINE (scm_version, "version", 0, 0, 0,
 
   char version_str[3 * 4 + 3];
 
+#if 0
 #if SCM_MAJOR_VERSION > 9999 \
     || SCM_MINOR_VERSION > 9999 \
     || SCM_MICRO_VERSION > 9999
 # error version string may overflow buffer
 #endif
+#endif
   sprintf (version_str, "%d.%d.%d",
-           SCM_MAJOR_VERSION,
-           SCM_MINOR_VERSION,
-           SCM_MICRO_VERSION);
+           1,
+           7,
+           0);
   return scm_makfrom0str (version_str);
 }
 #undef FUNC_NAME
@@ -140,10 +142,12 @@ SCM_DEFINE (scm_effective_version, "effective-version", 0, 0, 0,
 
   char version_str[2 * 4 + 3];
 
+#if 0
 #if (SCM_MAJOR_VERSION > 9999 || SCM_MINOR_VERSION > 9999)
 # error version string may overflow buffer
 #endif
-  sprintf (version_str, "%d.%d", SCM_MAJOR_VERSION, SCM_MINOR_VERSION);
+#endif
+  sprintf (version_str, "%d.%d", 1, 7);
   return scm_makfrom0str (version_str);
 }
 #undef FUNC_NAME