}
}
-
/*** 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;
SCM_STACKITEM *top;
jmp_buf regs;
-} scm_thread;
+};
static SCM
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;
}
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
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;
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.
{
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;
}
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;
}
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;
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,
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
{
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. */
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));
}
#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} "
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;
}
#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
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 ();
}
#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)
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--;
{
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
"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
}
}
- 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
"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
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
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
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)
{
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;
}
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,
}
#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
c-file-style: "gnu"
End:
*/
-
/* 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);
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
};
#endif
-#ifdef USE_COPT_THREADS
+#ifdef USE_PTHREAD_THREADS
#include "libguile/pthread-threads.h"
#else
#include "libguile/null-threads.h"
HCoop / bpt / guile.git / commitdiff