* threads.h, async.h, threads.c (SCM_CRITICAL_SECTION_START,

SCM_CRITICAL_SECTION_END): Moved here from threads.h since now
they also block/unblock execution of asyncs and call
scm_async_click which is declared in async.h but threads.h can not
include async.h since async.h already includes threads.h.
(scm_i_critical_section_level): New, for checking mistakes in the
use of the SCM_CRITICAL_SECTION_* macros.
(scm_i_critical_section_mutex): Make it a recursive mutex so that
critical sections can be nested.

* threads.h, threads.c (scm_frame_lock_mutex): New.
(scm_frame_critical_section): Take mutex as argument.
(framed_critical_section_mutex): New, used as default for above.
(scm_init_threads): Initialize it.
(scm_threads_prehistory): Do not initialize thread_admin_mutex and
scm_i_critical_section_mutex; both are initialized statically.

libguile/async.h

@@ -51,6 +51,32 @@ void *scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d);
 void scm_frame_block_asyncs (void);
 void scm_frame_unblock_asyncs (void);
 
+/* Critical sections */
+
+/* XXX - every critical section needs to be examined whether the
+   requirements for SCM_CRITICAL_SECTION_START/END are fulfilled.  See
+   the manual.
+*/
+
+/* Defined in threads.c.  scm_i_critical_section_level is only used
+   for error checking and will go away eventually. */
+extern scm_i_pthread_mutex_t scm_i_critical_section_mutex;
+extern int scm_i_critical_section_level;
+
+#define SCM_CRITICAL_SECTION_START \
+  do { \
+    scm_i_pthread_mutex_lock (&scm_i_critical_section_mutex);\
+    SCM_I_CURRENT_THREAD->block_asyncs++; \
+    scm_i_critical_section_level++; \
+  } while (0)
+#define SCM_CRITICAL_SECTION_END \
+  do { \
+    scm_i_critical_section_level--; \
+    SCM_I_CURRENT_THREAD->block_asyncs--; \
+    scm_i_pthread_mutex_unlock (&scm_i_critical_section_mutex); \
+    scm_async_click ();	\
+  } while (0)
+
 SCM_API void scm_init_async (void);
 
 #if (SCM_ENABLE_DEPRECATED == 1)

libguile/threads.c

@@ -876,6 +876,15 @@ SCM_DEFINE (scm_lock_mutex, "lock-mutex", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+void
+scm_frame_lock_mutex (SCM mutex)
+{
+  scm_frame_unwind_handler_with_scm ((void(*)(SCM))scm_unlock_mutex, mutex,
+				     SCM_F_WIND_EXPLICITLY);
+  scm_frame_rewind_handler_with_scm ((void(*)(SCM))scm_lock_mutex, mutex,
+				     SCM_F_WIND_EXPLICITLY);
+}
+
 static char *
 fat_mutex_trylock (fat_mutex *m, int *resp)
 {
@@ -1490,13 +1499,20 @@ scm_i_frame_single_threaded ()
   scm_frame_unwind_handler (wake_up, NULL, SCM_F_WIND_EXPLICITLY);
 }
 
+/* This mutex is used by SCM_CRITICAL_SECTION_START/END.
+ */
 scm_i_pthread_mutex_t scm_i_critical_section_mutex =
-  SCM_I_PTHREAD_MUTEX_INITIALIZER;
+  SCM_I_PTHREAD_RECURSIVE_MUTEX_INITIALIZER;
+int scm_i_critical_section_level = 0;
+
+static SCM framed_critical_section_mutex;
 
 void
-scm_frame_critical_section ()
+scm_frame_critical_section (SCM mutex)
 {
-  scm_i_frame_pthread_mutex_lock (&scm_i_critical_section_mutex);
+  if (scm_is_false (mutex))
+    mutex = framed_critical_section_mutex;
+  scm_frame_lock_mutex (mutex);
   scm_frame_block_asyncs ();
 }
 
@@ -1508,10 +1524,8 @@ scm_i_pthread_mutex_t scm_i_misc_mutex;
 void
 scm_threads_prehistory (SCM_STACKITEM *base)
 {
-  scm_i_pthread_mutex_init (&thread_admin_mutex, NULL);
   scm_i_pthread_mutex_init (&scm_i_misc_mutex, NULL);
   scm_i_pthread_cond_init (&wake_up_cond, NULL);
-  scm_i_pthread_mutex_init (&scm_i_critical_section_mutex, NULL);
   scm_i_pthread_key_create (&scm_i_freelist, NULL);
   scm_i_pthread_key_create (&scm_i_freelist2, NULL);
   
@@ -1544,6 +1558,9 @@ scm_init_threads ()
   scm_i_default_dynamic_state = SCM_BOOL_F;
   guilify_self_2 (SCM_BOOL_F);
   threads_initialized_p = 1;
+
+  framed_critical_section_mutex =
+    scm_permanent_object (scm_make_recursive_mutex ());
 }
 
 void

libguile/threads.h

@@ -132,18 +132,6 @@ SCM_API void *scm_with_guile (void *(*func)(void *), void *data);
 SCM_API void *scm_i_with_guile_and_parent (void *(*func)(void *), void *data,
 					   SCM parent);
 
-/* Critical sections */
-
-/* XXX - every critical section needs to be examined and protected
-   with scm_frame_critical_section, say.
-*/
-
-extern scm_i_pthread_mutex_t scm_i_critical_section_mutex;
-
-#define SCM_CRITICAL_SECTION_START \
-  scm_i_pthread_mutex_lock (&scm_i_critical_section_mutex)
-#define SCM_CRITICAL_SECTION_END \
-  scm_i_pthread_mutex_unlock (&scm_i_critical_section_mutex)
 
 extern int scm_i_thread_go_to_sleep;
 
@@ -174,6 +162,7 @@ SCM_API SCM scm_join_thread (SCM t);
 SCM_API SCM scm_make_mutex (void);
 SCM_API SCM scm_make_recursive_mutex (void);
 SCM_API SCM scm_lock_mutex (SCM m);
+SCM_API void scm_frame_lock_mutex (SCM mutex);
 SCM_API SCM scm_try_mutex (SCM m);
 SCM_API SCM scm_unlock_mutex (SCM m);
 
@@ -190,7 +179,7 @@ SCM_API SCM scm_all_threads (void);
 SCM_API int scm_c_thread_exited_p (SCM thread);
 SCM_API SCM scm_thread_exited_p (SCM thread);
 
-SCM_API void scm_frame_critical_section (void);
+SCM_API void scm_frame_critical_section (SCM mutex);
 
 #define SCM_I_CURRENT_THREAD \
   ((scm_i_thread *) scm_i_pthread_getspecific (scm_i_thread_key))