-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003 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
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
\f
C level threads.
*/
+#include "libguile/_scm.h"
+
+#if HAVE_UNISTD_H
#include <unistd.h>
+#endif
#include <stdio.h>
#include <assert.h>
+#if HAVE_SYS_TIME_H
#include <sys/time.h>
+#endif
-#include "libguile/_scm.h"
#include "libguile/validate.h"
#include "libguile/root.h"
#include "libguile/eval.h"
SCM result;
int exited;
- SCM joining_threads;
-
/* For keeping track of the stack and registers. */
SCM_STACKITEM *base;
SCM_STACKITEM *top;
t->handle = z;
t->result = creation_protects;
t->base = NULL;
- t->joining_threads = make_queue ();
scm_i_plugin_cond_init (&t->sleep_cond, 0);
- scm_i_plugin_mutex_init (&t->heap_mutex, 0);
+ scm_i_plugin_mutex_init (&t->heap_mutex, &scm_i_plugin_mutex);
t->clear_freelists_p = 0;
t->exited = 0;
return z;
{
scm_thread *t = SCM_THREAD_DATA (obj);
scm_gc_mark (t->result);
- scm_gc_mark (t->joining_threads);
return t->root->handle; /* mark root-state of this thread */
}
{
scm_thread *t = SCM_THREAD_DATA (exp);
scm_puts ("#<thread ", port);
+ scm_intprint ((unsigned long)t->thread, 10, port);
+ scm_puts (" (", port);
scm_intprint ((unsigned long)t, 16, port);
- scm_putc ('>', port);
+ scm_puts (")>", port);
return 1;
}
scm_thread *c = SCM_CURRENT_THREAD;
/* record top of stack for the GC */
- c->top = (SCM_STACKITEM *)&c;
+ c->top = SCM_STACK_PTR (&c);
/* save registers. */
SCM_FLUSH_REGISTER_WINDOWS;
setjmp (c->regs);
reached. Return 0 when it has been unblocked; errno otherwise.
*/
static int
-timed_block (const struct timespec *at)
+timed_block (const scm_t_timespec *at)
{
int err;
scm_thread *t = suspend ();
data,
(scm_t_catch_handler) handler_bootstrip,
data, base);
+ scm_i_leave_guile (); /* release the heap */
free (data);
- scm_thread_detach (t->thread);
scm_i_plugin_mutex_lock (&thread_admin_mutex);
all_threads = scm_delq_x (thread, all_threads);
t->exited = 1;
thread_count--;
+ /* detach before unlocking in order to not become joined when detached */
+ scm_thread_detach (t->thread);
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
- /* We're leaving with heap_mutex still locked. */
}
static void *
launch_thread (void *p)
{
- really_launch ((SCM_STACKITEM *)&p, (launch_data *)p);
+ really_launch (SCM_STACK_PTR (&p), (launch_data *) p);
return 0;
}
{
scm_t_thread th;
- SCM root, old_winds, new_threads;
+ SCM root;
launch_data *data;
scm_thread *t;
int err;
- /* Unwind wind chain. */
- old_winds = scm_dynwinds;
- scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds));
-
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
data = scm_malloc (sizeof (launch_data));
/* must initialize root state pointer before the thread is linked
into all_threads */
t->root = SCM_ROOT_STATE (root);
+ /* disconnect from parent, to prevent remembering dead threads */
+ t->root->parent = SCM_BOOL_F;
+ /* start with an empty dynwind chain */
+ t->root->dynwinds = SCM_EOL;
/* 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);
+ {
+ SCM new_threads = scm_cons (thread, SCM_BOOL_F); /* could cause GC */
+ scm_thread *parent = scm_i_leave_guile (); /* to prevent deadlock */
+ 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);
+
+ scm_remember_upto_here_1 (root);
+
+ scm_i_enter_guile (parent);
+ }
err = scm_i_plugin_thread_create (&th, 0, launch_thread, (void *) data);
if (err != 0)
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
}
- /* Return to old dynamic context. */
- scm_dowinds (old_winds, - scm_ilength (old_winds));
-
if (err)
{
errno = err;
}
#undef FUNC_NAME
+SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
+ (),
+"Move the calling thread to the end of the scheduling queue.")
+#define FUNC_NAME s_scm_yield
+{
+ return SCM_BOOL (scm_thread_yield);
+}
+#undef FUNC_NAME
+
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 = 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);
}
{
SCM mx = scm_make_smob (scm_tc16_fair_mutex);
fair_mutex *m = SCM_MUTEX_DATA (mx);
- scm_i_plugin_mutex_init (&m->lock, 0);
+ scm_i_plugin_mutex_init (&m->lock, &scm_i_plugin_mutex);
m->lockedp = 0;
m->owner = SCM_BOOL_F;
m->level = 0;
static int
fair_cond_timedwait (fair_cond *c,
fair_mutex *m,
- const struct timespec *waittime)
+ const scm_t_timespec *waittime)
{
int err;
scm_i_plugin_mutex_lock (&c->lock);
#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);
+ scm_i_plugin_mutex_init (SCM_MUTEX_DATA (mx), &scm_i_plugin_mutex);
return mx;
}
#undef FUNC_NAME
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)
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)
else
{
scm_t_mutex *m = SCM_MUTEX_DATA (mx);
- err = scm_i_plugin_mutex_unlock (m);
+ err = scm_mutex_unlock (m);
}
if (err)
"is returned. ")
#define FUNC_NAME s_scm_timed_wait_condition_variable
{
- struct timespec waittime;
+ scm_t_timespec waittime;
int err;
SCM_VALIDATE_CONDVAR (1, cv);
{
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);
+ if (SCM_UNBNDP (t))
+ err = scm_cond_wait (c, m);
+ else
+ err = scm_cond_timedwait (c, m, &waittime);
}
if (err)
{
+ if (err == ETIMEDOUT)
+ return SCM_BOOL_F;
errno = err;
SCM_SYSERROR;
}
else
{
scm_t_cond *c = SCM_CONDVAR_DATA (cv);
- scm_i_plugin_cond_signal (c);
+ scm_cond_signal (c);
}
return SCM_BOOL_T;
}
else
{
scm_t_cond *c = SCM_CONDVAR_DATA (cv);
- scm_i_plugin_cond_broadcast (c);
+ scm_cond_broadcast (c);
}
return SCM_BOOL_T;
}
/* Active thread */
/* stack_len is long rather than sizet in order to guarantee
that &stack_len is long aligned */
-#ifdef STACK_GROWS_UP
- stack_len = ((SCM_STACKITEM *) (&t) -
- (SCM_STACKITEM *) thread->base);
+#if SCM_STACK_GROWS_UP
+ stack_len = SCM_STACK_PTR (&t) - t->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
- stack_len = ((SCM_STACKITEM *) t->base -
- (SCM_STACKITEM *) (&t));
+ stack_len = t->base - SCM_STACK_PTR (&t);
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
- scm_mark_locations ((SCM_STACKITEM *) &t,
- stack_len);
+ scm_mark_locations (SCM_STACK_PTR (&t), stack_len);
#endif
}
else
{
/* Suspended thread */
-#ifdef STACK_GROWS_UP
+#if SCM_STACK_GROWS_UP
long stack_len = t->top - t->base;
scm_mark_locations (t->base, stack_len);
#else
return res;
}
+scm_t_rec_mutex *
+scm_make_rec_mutex ()
+{
+ scm_t_rec_mutex *m = scm_malloc (sizeof (scm_t_rec_mutex));
+ scm_i_plugin_rec_mutex_init (m, &scm_i_plugin_rec_mutex);
+ return m;
+}
+
+void
+scm_rec_mutex_free (scm_t_rec_mutex *m)
+{
+ scm_i_plugin_rec_mutex_destroy (m);
+ free (m);
+}
+
+int
+scm_rec_mutex_lock (scm_t_rec_mutex *m)
+{
+ scm_thread *t = scm_i_leave_guile ();
+ int res = scm_i_plugin_rec_mutex_lock (m);
+ scm_i_enter_guile (t);
+ return res;
+}
+
int
scm_cond_wait (scm_t_cond *c, scm_t_mutex *m)
{
}
int
-scm_cond_timedwait (scm_t_cond *c, scm_t_mutex *m, const struct timespec *wt)
+scm_cond_timedwait (scm_t_cond *c, scm_t_mutex *m, const scm_t_timespec *wt)
{
scm_thread *t = scm_i_leave_guile ();
int res = scm_i_plugin_cond_timedwait (c, m, wt);
return res;
}
+void *
+scm_getspecific (scm_t_key k)
+{
+ return scm_i_plugin_getspecific (k);
+}
+
+int
+scm_setspecific (scm_t_key k, void *s)
+{
+ return scm_i_plugin_setspecific (k, s);
+}
+
void
scm_enter_guile ()
{
"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
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)
+ if (threads_initialized_p && !gc_section_count++)
{
- SCM threads = all_threads;
+ SCM threads;
+ scm_i_plugin_mutex_lock (&thread_admin_mutex);
+ 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_invalidate_freelists ()
+{
+ /* Don't need to lock thread_admin_mutex here since we are single threaded */
+ SCM threads = all_threads;
+ 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;
+ }
+}
+
void
scm_i_thread_wake_up ()
{
- if (threads_initialized_p && gc_section_count == 1)
+ if (threads_initialized_p && !--gc_section_count)
{
- SCM threads = all_threads;
- resume (gc_thread);
+ SCM threads;
+ threads = all_threads;
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_i_plugin_mutex_unlock (&thread_admin_mutex);
}
- SCM_REC_CRITICAL_SECTION_END (gc_section);
}
void
{
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 */
+ resume (t);
}
-/* 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;
+scm_t_rec_mutex scm_i_defer_mutex;
+
+#if SCM_USE_PTHREAD_THREADS
+# include "libguile/pthread-threads.c"
+#endif
+#include "libguile/threads-plugin.c"
/*** Initialization */
scm_threads_prehistory ()
{
scm_thread *t;
- scm_i_plugin_mutex_init (&thread_admin_mutex, 0);
- scm_i_plugin_mutex_init (&gc_section_mutex, 0);
+#if SCM_USE_PTHREAD_THREADS
+ /* Must be called before any initialization of a mutex. */
+ scm_init_pthread_threads ();
+#endif
+ scm_i_plugin_mutex_init (&thread_admin_mutex, &scm_i_plugin_mutex);
scm_i_plugin_cond_init (&wake_up_cond, 0);
- scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, 0);
+ scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, &scm_i_plugin_mutex);
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);
+ scm_i_plugin_rec_mutex_init (&scm_i_defer_mutex, &scm_i_plugin_rec_mutex);
/* Allocate a fake thread object to be used during bootup. */
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;
+scm_t_bits scm_tc16_future;
scm_t_bits scm_tc16_mutex;
scm_t_bits scm_tc16_fair_mutex;
scm_t_bits scm_tc16_condvar;
HCoop / bpt / guile.git / blobdiff