mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Some harmless renamings of internal stuff.

Browse source 
(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.
This commit is contained in:
Marius Vollmer 2002-11-03 00:48:41 +00:00
parent d52f53b1ff
commit 05166e1aac
1 changed files with 84 additions and 180 deletions
Download patch file Download diff file Expand all files Collapse all files

264
libguile/coop-pthreads.c
View file

@ -118,13 +118,13 @@ typedef struct scm_copt_thread {
} scm_copt_thread; } scm_copt_thread;
static SCM static SCM
make_thread (SCM args) make_thread (SCM creation_protects)
{ {
SCM z; SCM z;
scm_copt_thread *t = scm_gc_malloc (sizeof(*t), "thread"); scm_copt_thread *t = scm_gc_malloc (sizeof(*t), "thread");
z = scm_cell (scm_tc16_thread, (scm_t_bits)t); z = scm_cell (scm_tc16_thread, (scm_t_bits)t);
t->handle = z; t->handle = z;
t->result = args; t->result = creation_protects;
t->base = NULL; t->base = NULL;
t->joining_threads = make_queue (); t->joining_threads = make_queue ();
pthread_cond_init (&t->sleep_cond, NULL); pthread_cond_init (&t->sleep_cond, NULL);
@ -154,9 +154,6 @@ static SCM
thread_mark (SCM obj) thread_mark (SCM obj)
{ {
scm_copt_thread *t = SCM_THREAD_DATA (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->result);
scm_gc_mark (t->joining_threads); scm_gc_mark (t->joining_threads);
return t->root->handle; return t->root->handle;
@ -183,9 +180,6 @@ static size_t
thread_free (SCM obj) thread_free (SCM obj)
{ {
scm_copt_thread *t = SCM_THREAD_DATA (obj); scm_copt_thread *t = SCM_THREAD_DATA (obj);
#ifdef DEBUG
// fprintf (stderr, "freeing %ld\n", t->pthread);
#endif
if (t->pthread != -1) if (t->pthread != -1)
abort (); abort ();
scm_gc_free (t, sizeof (*t), "thread"); scm_gc_free (t, sizeof (*t), "thread");
@ -414,11 +408,9 @@ int scm_i_switch_counter;
SCM SCM
scm_yield () scm_yield ()
{ {
/* Testing guile_mutex.next_waiting is safe since only the owner of /* Testing guile_mutex.next_waiting without locking guile_mutex.lock
guile_mutex can bring it from non-NULL to NULL. We are the is OK since the outcome is not critical. Even when it changes
owner, so that can not happen. When it goes from NULL to after the test, we do the right thing.
non-NULL, we might miss it this time, but next time we will
yield.
*/ */
if (guile_mutex.next_waiting) if (guile_mutex.next_waiting)
{ {
@ -466,43 +458,47 @@ unblock (scm_copt_thread *t)
static SCM all_threads; static SCM all_threads;
static int thread_count; static int thread_count;
typedef struct scheme_launch_data { typedef struct launch_data {
SCM thread;
SCM rootcont; SCM rootcont;
SCM body; scm_t_catch_body body;
SCM handler; void *body_data;
} scheme_launch_data; scm_t_catch_handler handler;
void *handler_data;
} launch_data;
static SCM static SCM
scheme_body_bootstrip (scheme_launch_data* data) body_bootstrip (launch_data* data)
{ {
/* First save the new root continuation */ /* First save the new root continuation */
data->rootcont = scm_root->rootcont; 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 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; 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 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); scm_copt_thread *t = SCM_THREAD_DATA (thread);
scheme_launch_data data;
init_thread_creatant (thread, base); init_thread_creatant (thread, base);
enter_guile (t); enter_guile (t);
data.rootcont = SCM_BOOL_F; data->rootcont = SCM_BOOL_F;
data.body = SCM_CAR (t->result);
data.handler = SCM_CADR (t->result);
t->result = t->result =
scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip, scm_internal_cwdr ((scm_t_catch_body) body_bootstrip,
&data, data,
(scm_t_catch_handler) scheme_handler_bootstrip, (scm_t_catch_handler) handler_bootstrip,
&data, base); data, base);
free (data);
pthread_detach (t->pthread); pthread_detach (t->pthread);
all_threads = scm_delq (thread, all_threads); all_threads = scm_delq (thread, all_threads);
@ -512,22 +508,66 @@ really_launch (SCM_STACKITEM *base, SCM thread)
} }
static void * 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; return NULL;
} }
static SCM
create_thread (scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data,
SCM protects)
{
SCM thread;
/* 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,
all its data is protected via all_threads.
*/
{
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 (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++;
/* Return to old dynamic context. */
scm_dowinds (old_winds, - scm_ilength (old_winds));
}
return thread;
}
SCM SCM
scm_call_with_new_thread (SCM argl) scm_call_with_new_thread (SCM argl)
#define FUNC_NAME s_call_with_new_thread #define FUNC_NAME s_call_with_new_thread
{ {
SCM thread; SCM thunk, handler;
/* Check arguments. */ /* Check arguments. */
{ {
register SCM args = argl; register SCM args = argl;
SCM thunk, handler;
if (!SCM_CONSP (args)) if (!SCM_CONSP (args))
SCM_WRONG_NUM_ARGS (); SCM_WRONG_NUM_ARGS ();
thunk = SCM_CAR (args); thunk = SCM_CAR (args);
@ -547,37 +587,19 @@ scm_call_with_new_thread (SCM argl)
SCM_WRONG_NUM_ARGS (); SCM_WRONG_NUM_ARGS ();
} }
/* Make new thread. The first thing the new thread will do is to return create_thread ((scm_t_catch_body) scm_call_0, thunk,
lock guile_mutex. Thus, we can safely complete its (scm_t_catch_handler) scm_apply_1, handler,
initialization after creating it. While the new thread starts, argl);
all its data is protected via all_threads.
*/
{
pthread_t th;
SCM root, old_winds;
/* 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 (argl);
pthread_create (&th, NULL, scheme_launch_thread, (void *) thread);
init_thread_creator (thread, th, SCM_ROOT_STATE (root));
all_threads = scm_cons (thread, all_threads);
thread_count++;
/* Return to old dynamic context. */
scm_dowinds (old_winds, - scm_ilength (old_winds));
}
return thread;
} }
#undef FUNC_NAME #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 */ /*** Mutexes */
/* We implement our own mutex type since we want them to be 'fair', we /* 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 #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: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"