summaryrefslogtreecommitdiff
path: root/libguile/coop-pthreads.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2002-11-03 00:48:41 +0000
committerMarius Vollmer <mvo@zagadka.de>2002-11-03 00:48:41 +0000
commit05166e1aacba1171a9936af654e44c7561b44bce (patch)
treefc60c06079376bf064edbfd068218bcab39a2494 /libguile/coop-pthreads.c
parentd52f53b1ff657762b203c12191a9fe7e5daa1987 (diff)
downloadguile-05166e1aacba1171a9936af654e44c7561b44bce.tar.gz
Some harmless renamings of internal stuff.
(create_thread): New, generalized version of scm_call_with_new_thread. (scm_call_with_new_thread): Use it. (scm_spawn_thread): New, use create_thread.
Diffstat (limited to 'libguile/coop-pthreads.c')
-rw-r--r--libguile/coop-pthreads.c262
1 files changed, 83 insertions, 179 deletions
diff --git a/libguile/coop-pthreads.c b/libguile/coop-pthreads.c
index 4014e92e7..f11db41c4 100644
--- a/libguile/coop-pthreads.c
+++ b/libguile/coop-pthreads.c
@@ -118,13 +118,13 @@ typedef struct scm_copt_thread {
} scm_copt_thread;
static SCM
-make_thread (SCM args)
+make_thread (SCM creation_protects)
{
SCM z;
scm_copt_thread *t = scm_gc_malloc (sizeof(*t), "thread");
z = scm_cell (scm_tc16_thread, (scm_t_bits)t);
t->handle = z;
- t->result = args;
+ t->result = creation_protects;
t->base = NULL;
t->joining_threads = make_queue ();
pthread_cond_init (&t->sleep_cond, NULL);
@@ -154,9 +154,6 @@ static SCM
thread_mark (SCM obj)
{
scm_copt_thread *t = SCM_THREAD_DATA (obj);
-#ifdef DEBUG
- // fprintf (stderr, "marking %ld\n", t->pthread);
-#endif
scm_gc_mark (t->result);
scm_gc_mark (t->joining_threads);
return t->root->handle;
@@ -183,9 +180,6 @@ static size_t
thread_free (SCM obj)
{
scm_copt_thread *t = SCM_THREAD_DATA (obj);
-#ifdef DEBUG
- // fprintf (stderr, "freeing %ld\n", t->pthread);
-#endif
if (t->pthread != -1)
abort ();
scm_gc_free (t, sizeof (*t), "thread");
@@ -414,11 +408,9 @@ int scm_i_switch_counter;
SCM
scm_yield ()
{
- /* Testing guile_mutex.next_waiting is safe since only the owner of
- guile_mutex can bring it from non-NULL to NULL. We are the
- owner, so that can not happen. When it goes from NULL to
- non-NULL, we might miss it this time, but next time we will
- 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)
{
@@ -466,43 +458,47 @@ unblock (scm_copt_thread *t)
static SCM all_threads;
static int thread_count;
-typedef struct scheme_launch_data {
+typedef struct launch_data {
+ SCM thread;
SCM rootcont;
- SCM body;
- SCM handler;
-} scheme_launch_data;
+ scm_t_catch_body body;
+ void *body_data;
+ scm_t_catch_handler handler;
+ void *handler_data;
+} launch_data;
static SCM
-scheme_body_bootstrip (scheme_launch_data* data)
+body_bootstrip (launch_data* data)
{
/* First save the new root continuation */
data->rootcont = scm_root->rootcont;
- return scm_call_0 (data->body);
+ return (data->body) (data->body_data);
+ // return scm_call_0 (data->body);
}
static SCM
-scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args)
+handler_bootstrip (launch_data* data, SCM tag, SCM throw_args)
{
scm_root->rootcont = data->rootcont;
- return scm_apply_1 (data->handler, tag, throw_args);
+ return (data->handler) (data->handler_data, tag, throw_args);
+ // return scm_apply_1 (data->handler, tag, throw_args);
}
static void
-really_launch (SCM_STACKITEM *base, SCM thread)
+really_launch (SCM_STACKITEM *base, launch_data *data)
{
+ SCM thread = data->thread;
scm_copt_thread *t = SCM_THREAD_DATA (thread);
- scheme_launch_data data;
init_thread_creatant (thread, base);
enter_guile (t);
- data.rootcont = SCM_BOOL_F;
- data.body = SCM_CAR (t->result);
- data.handler = SCM_CADR (t->result);
+ data->rootcont = SCM_BOOL_F;
t->result =
- scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip,
- &data,
- (scm_t_catch_handler) scheme_handler_bootstrip,
- &data, base);
+ scm_internal_cwdr ((scm_t_catch_body) body_bootstrip,
+ data,
+ (scm_t_catch_handler) handler_bootstrip,
+ data, base);
+ free (data);
pthread_detach (t->pthread);
all_threads = scm_delq (thread, all_threads);
@@ -512,41 +508,19 @@ really_launch (SCM_STACKITEM *base, SCM thread)
}
static void *
-scheme_launch_thread (void *p)
+launch_thread (void *p)
{
- really_launch ((SCM_STACKITEM *)&p, (SCM)p);
+ really_launch ((SCM_STACKITEM *)&p, (launch_data *)p);
return NULL;
}
-SCM
-scm_call_with_new_thread (SCM argl)
-#define FUNC_NAME s_call_with_new_thread
+static SCM
+create_thread (scm_t_catch_body body, void *body_data,
+ scm_t_catch_handler handler, void *handler_data,
+ SCM protects)
{
SCM thread;
- /* Check arguments. */
- {
- register SCM args = argl;
- SCM thunk, handler;
- if (!SCM_CONSP (args))
- SCM_WRONG_NUM_ARGS ();
- thunk = SCM_CAR (args);
- SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
- thunk,
- SCM_ARG1,
- s_call_with_new_thread);
- args = SCM_CDR (args);
- if (!SCM_CONSP (args))
- SCM_WRONG_NUM_ARGS ();
- handler = SCM_CAR (args);
- SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)),
- handler,
- SCM_ARG2,
- s_call_with_new_thread);
- if (!SCM_NULLP (SCM_CDR (args)))
- SCM_WRONG_NUM_ARGS ();
- }
-
/* Make new thread. The first thing the new thread will do is to
lock guile_mutex. Thus, we can safely complete its
initialization after creating it. While the new thread starts,
@@ -556,16 +530,24 @@ scm_call_with_new_thread (SCM argl)
{
pthread_t th;
SCM root, old_winds;
-
+ launch_data *data;
+
/* 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));
+
/* Make thread. */
- thread = make_thread (argl);
- pthread_create (&th, NULL, scheme_launch_thread, (void *) thread);
+ thread = make_thread (protects);
+ data->thread = thread;
+ data->body = body;
+ data->body_data = body_data;
+ data->handler = handler;
+ data->handler_data = handler_data;
+ pthread_create (&th, NULL, launch_thread, (void *) data);
init_thread_creator (thread, th, SCM_ROOT_STATE (root));
all_threads = scm_cons (thread, all_threads);
thread_count++;
@@ -576,8 +558,48 @@ scm_call_with_new_thread (SCM argl)
return thread;
}
+
+SCM
+scm_call_with_new_thread (SCM argl)
+#define FUNC_NAME s_call_with_new_thread
+{
+ SCM thunk, handler;
+
+ /* Check arguments. */
+ {
+ register SCM args = argl;
+ if (!SCM_CONSP (args))
+ SCM_WRONG_NUM_ARGS ();
+ thunk = SCM_CAR (args);
+ SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
+ thunk,
+ SCM_ARG1,
+ s_call_with_new_thread);
+ args = SCM_CDR (args);
+ if (!SCM_CONSP (args))
+ SCM_WRONG_NUM_ARGS ();
+ handler = SCM_CAR (args);
+ SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)),
+ handler,
+ SCM_ARG2,
+ s_call_with_new_thread);
+ if (!SCM_NULLP (SCM_CDR (args)))
+ SCM_WRONG_NUM_ARGS ();
+ }
+
+ return create_thread ((scm_t_catch_body) scm_call_0, thunk,
+ (scm_t_catch_handler) scm_apply_1, handler,
+ argl);
+}
#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);
+}
+
/*** Mutexes */
/* We implement our own mutex type since we want them to be 'fair', we
@@ -1033,124 +1055,6 @@ scm_c_thread_exited_p (SCM thread)
}
#undef FUNC_NAME
-
-/* XXX from here to end */
-
-#if 0
-/* NOTE: There are TWO mechanisms for starting a thread: The first one
- is used when spawning a thread from Scheme, while the second one is
- used from C.
-
- It might be argued that the first should be implemented in terms of
- the second. The reason it isn't is that that would require an
- extra unnecessary malloc (the thread_args structure). By providing
- one pair of extra functions (c_launch_thread, scm_spawn_thread) the
- Scheme threads are started more efficiently. */
-
-/* This is the first thread spawning mechanism: threads from Scheme */
-
-
-
-/* This is the second thread spawning mechanism: threads from C */
-
-typedef struct c_launch_data {
- union {
- SCM thread;
- SCM rootcont;
- } u;
- scm_t_catch_body body;
- void *body_data;
- scm_t_catch_handler handler;
- void *handler_data;
-} c_launch_data;
-
-static SCM
-c_body_bootstrip (c_launch_data* data)
-{
- /* First save the new root continuation */
- data->u.rootcont = scm_root->rootcont;
- return (data->body) (data->body_data);
-}
-
-static SCM
-c_handler_bootstrip (c_launch_data* data, SCM tag, SCM throw_args)
-{
- scm_root->rootcont = data->u.rootcont;
- return (data->handler) (data->handler_data, tag, throw_args);
-}
-
-static void
-c_really_launch (void *p)
-{
- SCM result;
- c_launch_data *data = (c_launch_data *) p;
- /* The thread object will be GC protected by being on this stack */
- SCM thread = data->u.thread;
- scm_copt_thread *t = SCM_THREAD_DATA (thread);
- /* We must use the address of `thread', otherwise the compiler will
- optimize it away. This is OK since the longest SCM_STACKITEM
- also is a long. */
- result = scm_internal_cwdr ((scm_t_catch_body) c_body_bootstrip,
- data,
- (scm_t_catch_handler) c_handler_bootstrip,
- data,
- (SCM_STACKITEM *) &thread);
- all_threads = scm_delq (thread, all_threads);
- t->result = result;
- pthread_detach (t->pthread);
- t->pthread = -1;
- thread_count--;
- free ((char *) data);
-}
-
-static void *
-c_launch_thread (void *p)
-{
- ticket t;
- enter_guile ((SCM_STACKITEM *)&t, &t);
- c_really_launch (p);
- leave_guile (&t);
- return NULL;
-}
-
-SCM
-scm_spawn_thread (scm_t_catch_body body, void *body_data,
- scm_t_catch_handler handler, void *handler_data)
-{
- SCM thread;
- pthread_t th;
- SCM root, old_winds;
- c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data));
-
- /* 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);
- /* Make thread. */
- thread = make_thread ();
- SCM_DEFER_INTS;
-
- data->u.thread = thread;
- data->body = body;
- data->body_data = body_data;
- data->handler = handler;
- data->handler_data = handler_data;
-
- pthread_create (&th, NULL, c_launch_thread, (void *) data);
- init_thread_creator (thread, th, SCM_ROOT_STATE (root));
- all_threads = scm_cons (thread, all_threads);
- thread_count++;
- SCM_ALLOW_INTS;
-
- /* Return to old dynamic context. */
- scm_dowinds (old_winds, - scm_ilength (old_winds));
-
- return thread;
-}
-#endif
-
/*
Local Variables:
c-file-style: "gnu"