* threads.c (scm_thread): Removed filed joining_threads.
authorMikael Djurfeldt <djurfeldt@nada.kth.se>
Mon, 16 Dec 2002 15:24:13 +0000 (15:24 +0000)
committerMikael Djurfeldt <djurfeldt@nada.kth.se>
Mon, 16 Dec 2002 15:24:13 +0000 (15:24 +0000)
(thread_print): Print thread number as well as address of thread
structure.
(scm_join_thread): Bugfix.
(scm_lock_mutex, scm_try_mutex, scm_unlock_mutex,
scm_timed_wait_condition_variable, scm_signal_condition_variable,
scm_broadcast_condition_variable): Use the low-level API.
(scm_all_threads): Return copy of thread list (to prevent
unintended destruction).
(scm_threads_prehistory): Initialize heap_mutex of fake thread.

libguile/ChangeLog
libguile/pthread-threads.c
libguile/pthread-threads.h
libguile/snarf.h
libguile/threads.c

index 875cb42..b13004f 100644 (file)
@@ -1,8 +1,15 @@
-2002-12-16  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+2002-12-16  Mikael Djurfeldt  <mdj@kvast.blakulla.net>
 
        * threads.c (scm_thread): Removed filed joining_threads.
        (thread_print): Print thread number as well as address of thread
        structure.
+       (scm_join_thread): Bugfix.
+       (scm_lock_mutex, scm_try_mutex, scm_unlock_mutex,
+       scm_timed_wait_condition_variable, scm_signal_condition_variable,
+       scm_broadcast_condition_variable): Use the low-level API.
+       (scm_all_threads): Return copy of thread list (to prevent
+       unintended destruction).
+       (scm_threads_prehistory): Initialize heap_mutex of fake thread.
 
        * pthread-threads.c, pthread-threads.h, threads.c: Fixes to
        pthread "native" recursive mutex support.
index cfb5ed5..58410db 100644 (file)
@@ -48,9 +48,12 @@ scm_t_mutexattr scm_i_plugin_mutex;
 
 scm_t_mutexattr scm_i_plugin_rec_mutex;
 
-#ifndef SCM_MUTEX_RECURSIVE
-#error hej
+#if !defined (SCM_MUTEX_RECURSIVE) || defined (SCM_DEBUG_THREADS)
+
 typedef struct rec_mutex {
+#ifdef SCM_DEBUG_THREADS
+  int kind;
+#endif
   scm_t_mutex mutex;
   scm_thread *owner;
   int count;
@@ -59,6 +62,92 @@ typedef struct rec_mutex {
 /* Mutex for recursive mutex administration */
 static scm_t_mutex rec_mutex_mutex;
 
+#ifdef SCM_DEBUG_THREADS
+
+#define FAST_MUTEX 1
+#define REC_MUTEX 2
+
+typedef struct mutex {
+#ifdef SCM_DEBUG_THREADS
+  int kind;
+#endif
+  pthread_mutex_t mutex;
+  scm_thread *owner;
+  int count;
+} mutex;
+
+static pthread_mutex_t mutex_mutex;
+
+int
+scm_i_plugin_mutex_init (scm_t_mutex *mx, const scm_t_mutexattr *a)
+{
+  mutex *m = (mutex *) mx;
+  pthread_mutex_init (&m->mutex, &scm_i_plugin_mutex);
+  m->owner = 0;
+  m->count = 0;
+  m->kind = FAST_MUTEX;
+  return 0;
+}
+
+int
+scm_i_plugin_mutex_lock (scm_t_mutex *mx)
+{
+  mutex *m = (mutex *) mx;
+  scm_thread *t = SCM_CURRENT_THREAD;
+  pthread_mutex_lock (&mutex_mutex);
+  if (m->kind != FAST_MUTEX)
+    {
+      fprintf (stderr,
+              m->kind == REC_MUTEX
+              ? "locking wrong mutex type\n"
+              : "locking uninitialized mutex\n");
+      abort ();
+    }
+  if (m->owner == t)
+    {
+      fprintf (stderr, "locking mutex already locked by self\n");
+      abort ();
+    }
+  pthread_mutex_unlock (&mutex_mutex);
+  pthread_mutex_lock (&m->mutex);
+  m->count = 1;
+  m->owner = t;
+  return 0;
+}
+
+int
+scm_i_plugin_mutex_unlock (scm_t_mutex *mx)
+{
+  mutex *m = (mutex *) mx;
+  pthread_mutex_lock (&mutex_mutex);
+  if (m->kind != FAST_MUTEX)
+    {
+      fprintf (stderr,
+              m->kind == REC_MUTEX
+              ? "locking wrong mutex type\n"
+              : "locking uninitialized mutex\n");
+      abort ();
+    }
+  if (m->count != 1)
+    {
+      fprintf (stderr,
+              m->count == 0
+              ? "unlocking unlocked mutex\n"
+              : "bogus internal state");
+      abort ();
+    }
+  m->owner = 0;
+  m->count = 0;
+  pthread_mutex_unlock (&m->mutex);
+  pthread_mutex_unlock (&mutex_mutex);
+  return 0;
+}
+#endif
+
+/* The following section belongs in threads.c, or rather
+   thread-plugin.c.  It is generic and not tied to any particular
+   thread library. */
+
 int
 scm_i_plugin_rec_mutex_init (scm_t_rec_mutex *mx, const scm_t_mutexattr *a)
 {
@@ -66,6 +155,9 @@ scm_i_plugin_rec_mutex_init (scm_t_rec_mutex *mx, const scm_t_mutexattr *a)
   scm_i_plugin_mutex_init (&m->mutex, &scm_i_plugin_mutex);
   m->owner = 0;
   m->count = 0;
+#ifdef SCM_DEBUG_THREADS
+  m->kind = REC_MUTEX;
+#endif
   return 0;
 }
 
@@ -75,6 +167,16 @@ scm_i_plugin_rec_mutex_lock (scm_t_rec_mutex *mx)
   rec_mutex *m = (rec_mutex *) mx;
   scm_thread *t = SCM_CURRENT_THREAD;
   scm_i_plugin_mutex_lock (&rec_mutex_mutex);
+#ifdef SCM_DEBUG_THREADS
+  if (m->kind != REC_MUTEX)
+    {
+      fprintf (stderr,
+              m->kind == FAST_MUTEX
+              ? "locking wrong mutex type\n"
+              : "locking uninitialized mutex\n");
+      abort ();
+    }
+#endif
   if (m->count && m->owner == t)
     {
       ++m->count;
@@ -118,6 +220,21 @@ scm_i_plugin_rec_mutex_unlock (scm_t_rec_mutex *mx)
 {
   rec_mutex *m = (rec_mutex *) mx;
   scm_i_plugin_mutex_lock (&rec_mutex_mutex);
+#ifdef SCM_DEBUG_THREADS
+  if (m->kind != REC_MUTEX)
+    {
+      fprintf (stderr,
+              m->kind == FAST_MUTEX
+              ? "locking wrong mutex type\n"
+              : "locking uninitialized mutex\n");
+      abort ();
+    }
+  if (m->count == 0)
+    {
+      fprintf (stderr, "unlocking unlocked mutex\n");
+      abort ();
+    }
+#endif
   if (!--m->count)
     {
       m->owner = 0;
@@ -136,26 +253,33 @@ int pthread_mutexattr_settype (pthread_mutexattr_t *, int);
 void
 scm_init_pthread_threads ()
 {
-  if (sizeof (scm_t_rec_mutex) > SCM_REC_MUTEX_MAXSIZE)
-    {
-      fprintf (stderr, "Internal error: Need to upgrade mutex size\n");
-      abort ();
-    }
-  
   pthread_mutexattr_init (&scm_i_plugin_mutex);
 #ifdef SCM_MUTEX_FAST
   pthread_mutexattr_settype (&scm_i_plugin_mutex, SCM_MUTEX_FAST);
 #endif
 
-#ifdef SCM_MUTEX_RECURSIVE /* Use the POSIX 1003.1c identifier */
-  pthread_mutexattr_init (&scm_i_plugin_rec_mutex);
+#if defined (SCM_MUTEX_RECURSIVE) && !defined (SCM_DEBUG_THREADS)
+  if (sizeof (pthread_mutex_t) > SCM_REC_MUTEX_MAXSIZE)
+    {
+      fprintf (stderr, "Internal error: Need to upgrade mutex size\n");
+      abort ();
+    }
+    pthread_mutexattr_init (&scm_i_plugin_rec_mutex);
   pthread_mutexattr_settype (&scm_i_plugin_rec_mutex, SCM_MUTEX_RECURSIVE);
 #else
   /* If PTHREAD_MUTEX_RECURSIVE is not defined,
      scm_i_plugin_rec_mutex_init won't pay attention to it anyway
   */
+  if (sizeof (rec_mutex) > SCM_REC_MUTEX_MAXSIZE)
+    {
+      fprintf (stderr, "Internal error: Need to upgrade mutex size\n");
+      abort ();
+    }
   scm_i_plugin_mutex_init (&rec_mutex_mutex, &scm_i_plugin_mutex);
 #endif
+#ifdef SCM_DEBUG_THREADS
+  pthread_mutex_init (&mutex_mutex, &scm_i_plugin_mutex);
+#endif
 }
 
 /*
index 006d06b..8b3d4fe 100644 (file)
@@ -52,6 +52,7 @@
 /* This is an interface between Guile and the pthreads thread package. */
 
 #include <pthread.h>
+#include <sched.h>
 
 /* MDJ 021209 <djurfeldt@nada.kth.se>:
    The separation of the plugin interface and the low-level C API
 
 #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_i_plugin_thread_self       pthread_self
+#define scm_i_plugin_thread_yield      sched_yield
 
-#define scm_t_mutex                    pthread_mutex_t
+/* Size is checked in scm_init_pthread_threads */
+#ifdef SCM_DEBUG_THREADS
+#define SCM_MUTEX_MAXSIZE (9 * sizeof (long))
+#else
+#define SCM_MUTEX_MAXSIZE (6 * sizeof (long))
+#endif
+typedef struct { char _[SCM_MUTEX_MAXSIZE]; } scm_t_mutex;
 #define scm_t_mutexattr                        pthread_mutexattr_t
 
 extern scm_t_mutexattr scm_i_plugin_mutex; /* The "fast" mutex. */
 
-#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 
+#ifdef SCM_DEBUG_THREADS
+int scm_i_plugin_mutex_init (scm_t_mutex *, const scm_t_mutexattr *);
+int scm_i_plugin_mutex_lock (scm_t_mutex *);
+int scm_i_plugin_mutex_unlock (scm_t_mutex *);
+#else
+#define scm_i_plugin_mutex_init(m,a) \
+  pthread_mutex_init ((pthread_mutex_t *) (m), (a))
+#define scm_i_plugin_mutex_lock(m) \
+  pthread_mutex_lock ((pthread_mutex_t *) (m))
+#define scm_i_plugin_mutex_unlock(m) \
+  pthread_mutex_unlock ((pthread_mutex_t *) (m))
+#endif
+#define scm_i_plugin_mutex_destroy(m) \
+  pthread_mutex_destroy ((pthread_mutex_t *) (m))
+#define scm_i_plugin_mutex_trylock(m) \
+  pthread_mutex_trylock ((pthread_mutex_t *) (m))
 
 /* Size is checked in scm_init_pthread_threads */
-#define SCM_REC_MUTEX_MAXSIZE (8 * sizeof (long))
+#ifdef SCM_DEBUG_THREADS
+#define SCM_REC_MUTEX_MAXSIZE (SCM_MUTEX_MAXSIZE + 3 * sizeof (long))
+#else
+#ifdef SCM_MUTEX_RECURSIVE
+#define SCM_REC_MUTEX_MAXSIZE SCM_MUTEX_MAXSIZE
+#else
+#define SCM_REC_MUTEX_MAXSIZE (SCM_MUTEX_MAXSIZE + 2 * sizeof (long))
+#endif
+#endif
 typedef struct { char _[SCM_REC_MUTEX_MAXSIZE]; } scm_t_rec_mutex;
 
 extern scm_t_mutexattr scm_i_plugin_rec_mutex;
 
-#ifdef SCM_MUTEX_RECURSIVE /* pthreads has recursive mutexes! */
+#if defined (SCM_MUTEX_RECURSIVE) && !defined (SCM_DEBUG_THREADS)
+/* pthreads has recursive mutexes! */
 #define scm_i_plugin_rec_mutex_init(m,a) \
   pthread_mutex_init ((pthread_mutex_t *) (m), (a))
 #define scm_i_plugin_rec_mutex_destroy(m) \
@@ -107,8 +135,10 @@ int scm_i_plugin_rec_mutex_unlock (scm_t_rec_mutex *);
 
 #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_wait(c, m) \
+  pthread_cond_wait ((c), (pthread_mutex_t *) (m))
+#define scm_i_plugin_cond_timedwait(c, m, t) \
+  pthread_cond_timedwait ((c), (pthread_mutex_t *) (m), (t))
 #define scm_i_plugin_cond_signal       pthread_cond_signal 
 #define scm_i_plugin_cond_broadcast    pthread_cond_broadcast 
 
index 7d6902e..8affa28 100644 (file)
@@ -217,7 +217,7 @@ SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
 
 #define SCM_GLOBAL_REC_MUTEX(c_name) \
 SCM_SNARF_HERE(scm_t_rec_mutex c_name) \
-SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
+SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
 
 #ifdef SCM_MAGIC_SNARF_DOCS
 #undef SCM_ASSERT
index 0bc5f07..dee62c5 100644 (file)
@@ -476,9 +476,10 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
   t = SCM_THREAD_DATA (thread);
   if (!t->exited)
     {
-      scm_thread *c = scm_i_leave_guile ();
+      scm_thread *c;
+      c = scm_i_leave_guile ();
       while (!THREAD_INITIALIZED_P (t))
-       SCM_TICK;
+       scm_i_plugin_thread_yield ();
       scm_thread_join (t->thread, 0);
       scm_i_enter_guile (c);
     }
@@ -784,9 +785,7 @@ SCM_DEFINE (scm_lock_mutex, "lock-mutex", 1, 0, 0,
   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);
+      err = scm_mutex_lock (m);
     }
 
   if (err)
@@ -812,9 +811,7 @@ SCM_DEFINE (scm_try_mutex, "try-mutex", 1, 0, 0,
   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);
+      err = scm_mutex_trylock (m);
     }
 
   if (err == EBUSY)
@@ -862,7 +859,7 @@ SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0,
   else
     {
       scm_t_mutex *m = SCM_MUTEX_DATA (mx);
-      err = scm_i_plugin_mutex_unlock (m);
+      err = scm_mutex_unlock (m);
     }
 
   if (err)
@@ -935,9 +932,7 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
     {
       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);
+      err = scm_cond_wait (c, m);
     }
 
   if (err)
@@ -960,7 +955,7 @@ SCM_DEFINE (scm_signal_condition_variable, "signal-condition-variable", 1, 0, 0,
   else
     {
       scm_t_cond *c = SCM_CONDVAR_DATA (cv);
-      scm_i_plugin_cond_signal (c);
+      scm_cond_signal (c);
     }
   return SCM_BOOL_T;
 }
@@ -977,7 +972,7 @@ SCM_DEFINE (scm_broadcast_condition_variable, "broadcast-condition-variable", 1,
   else
     {
       scm_t_cond *c = SCM_CONDVAR_DATA (cv);
-      scm_i_plugin_cond_broadcast (c);
+      scm_cond_broadcast (c);
     }
   return SCM_BOOL_T;
 }
@@ -1213,7 +1208,7 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
            "Return a list of all threads.")
 #define FUNC_NAME s_scm_all_threads
 {
-  return all_threads;
+  return scm_list_copy (all_threads);
 }
 #undef FUNC_NAME
 
@@ -1343,7 +1338,9 @@ scm_threads_prehistory ()
   t = malloc (sizeof (scm_thread));
   t->base = NULL;
   t->clear_freelists_p = 0;
+  scm_i_plugin_mutex_init (&t->heap_mutex, &scm_i_plugin_mutex);
   scm_setspecific (scm_i_thread_key, t);
+  scm_i_enter_guile (t);
 }
 
 scm_t_bits scm_tc16_thread;