summaryrefslogtreecommitdiff
path: root/libguile/coop-pthreads.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2002-10-30 10:41:51 +0000
committerMarius Vollmer <mvo@zagadka.de>2002-10-30 10:41:51 +0000
commitcf8ea1a3d1fcac51a4fa2676d46655a21f0bc50d (patch)
tree1854efd7b781f25d1e5baa89bf5764d47d3a8fcb /libguile/coop-pthreads.c
parentd703aba57ac1c35cdc1b995eba1d8e68a6799534 (diff)
downloadguile-cf8ea1a3d1fcac51a4fa2676d46655a21f0bc50d.tar.gz
Updated, but still totally unusable.
Diffstat (limited to 'libguile/coop-pthreads.c')
-rw-r--r--libguile/coop-pthreads.c974
1 files changed, 508 insertions, 466 deletions
diff --git a/libguile/coop-pthreads.c b/libguile/coop-pthreads.c
index a84d44fae..67d41d068 100644
--- a/libguile/coop-pthreads.c
+++ b/libguile/coop-pthreads.c
@@ -54,249 +54,521 @@
#undef DEBUG
+/* This thread implementation uses POSIX threads but allows only
+ thread to really execute at any one time.
+
+ XXX - more overview here.
+*/
+
+/* All data is protected by a single mutex: guile_mutex. */
+
static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER;
-pthread_t guile_thread;
-static SCM all_threads;
-static int thread_count;
+/*** Threads */
-static pthread_key_t handle_key;
+typedef struct scm_copt_thread {
+
+ /* A condition variable for sleeping on.
+ */
+ pthread_cond_t sleep_cond;
-/* The following functions are for managing a threads visit in Guile
- land. A thread can be in one of three states: outside, active, or
- suspended. "Outside" means that the thread can not call any Guile
- related functions and can not store SCM values in local variables.
- "Active" or "suspended" means that a thread can use Guile and can
- store SCM values in its stack. An "active" thread is currently
- executing while a "suspended" one is waiting to become active
- again. There can only be one "active" thread at any one time.
-*/
+ /* A link for the ready queue.
+ */
+ struct scm_copt_thread *next_ready;
-typedef struct ticket {
- struct ticket *next;
- struct ticket **prevp;
+ scm_root_state *root;
+ SCM handle;
+ pthread_t pthread;
+ SCM result;
+
+ /* For keeping track of the stack and registers. */
SCM_STACKITEM *base;
SCM_STACKITEM *top;
jmp_buf regs;
-} ticket;
-static ticket *tickets = NULL;
-static pthread_key_t ticket_key;
+} scm_copt_thread;
-/* Enter Guile land. While in Guile land, the stack between BASE and
- the current stack pointer will be scanned for SCM references. Only
- one thread can be in Guile land at any one time. When you try to
- enter it while another one is already there, you will be put to
- sleep until it leaves or suspends.
- */
-static void
-enter_guile (SCM_STACKITEM *base, ticket *t)
+static SCM
+make_thread (SCM args)
{
- pthread_mutex_lock (&guile_mutex);
- guile_thread = pthread_self ();
-
-#ifdef DEBUG
- fprintf (stderr, "thread %ld entered\n", pthread_self ());
-#endif
+ 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;
+ return z;
+}
- /* Ok, we are in. Stamp our ticket. */
- t->next = tickets;
- if (tickets)
- tickets->prevp = &t->next;
- tickets = t;
- t->prevp = &tickets;
+static void
+init_thread_creator (SCM thread, pthread_t th, scm_root_state *r)
+{
+ scm_copt_thread *t = SCM_THREAD_DATA(thread);
+ t->root = r;
+ t->pthread = th;
+ pthread_cond_init (&t->sleep_cond, NULL);
+}
+static void
+init_thread_creatant (SCM thread, SCM_STACKITEM *base)
+{
+ scm_copt_thread *t = SCM_THREAD_DATA(thread);
t->base = base;
t->top = NULL;
+}
- pthread_setspecific (ticket_key, (void *)t);
+static SCM
+thread_mark (SCM obj)
+{
+ scm_copt_thread *t = SCM_THREAD_DATA (obj);
+ scm_gc_mark (t->result);
+ return t->root->handle;
}
-/* Leave Guile land so that the next thread can enter. This function
- must be called from the same stack frame as the corresponding
- enter_guile. The stack of this thread will no longer be scanned.
-*/
-static void
-leave_guile (ticket *t)
+static int
+thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- /* Remove ticket... */
- *t->prevp = t->next;
- if (t->next)
- t->next->prevp = t->prevp;
+ scm_copt_thread *t = SCM_THREAD_DATA (exp);
+ scm_puts ("#<thread ", port);
+ scm_intprint ((unsigned long)t, 16, port);
+ if (t->pthread != -1)
+ {
+ scm_putc (' ', port);
+ scm_intprint (t->pthread, 10, port);
+ }
+ else
+ scm_puts (" (exited)", port);
+ scm_putc ('>', port);
+ return 1;
+}
-#ifdef DEBUG
- fprintf (stderr, "thread %ld left\n", pthread_self ());
-#endif
+static size_t
+thread_free (SCM obj)
+{
+ scm_copt_thread *t = SCM_THREAD_DATA (obj);
+ if (t->pthread != -1)
+ abort ();
+ scm_gc_free (t, sizeof (*t), "thread");
+ return 0;
+}
- /* ...and leave. */
- guile_thread = 0;
- pthread_mutex_unlock (&guile_mutex);
+/*** Queues */
+
+static SCM
+make_queue ()
+{
+ return scm_cons (SCM_EOL, SCM_EOL);
+}
+
+static void
+enqueue (SCM q, SCM t)
+{
+ SCM c = scm_cons (t, SCM_EOL);
+ if (SCM_NULLP (SCM_CAR (q)))
+ SCM_SETCAR (q, c);
+ else
+ SCM_SETCDR (SCM_CDR (q), c);
+ SCM_SETCDR (q, c);
}
-/* Suspend the visit in Guile land so that other threads can resume
- their visit or enter. While a thread is suspended, its stack is
- scanned between BASE (as given to enter_guile) and TOP (as given
- here).
+static SCM
+dequeue (SCM q)
+{
+ SCM c = SCM_CAR (q);
+ if (SCM_NULLP (c))
+ return SCM_BOOL_F;
+ else
+ {
+ SCM_SETCAR (q, SCM_CDR (c));
+ if (SCM_NULLP (SCM_CAR (q)))
+ SCM_SETCDR (q, SCM_EOL);
+ return SCM_CAR (c);
+ }
+}
+
+/*** Ready queue */
+
+/* Normally, queues are implemented with the procedures above, but the
+ ready queue is special. We need to put threads on it from the
+ 'outside', i.e., when we don't hold the guile_mutex. That's why
+ the ready queue has its own mutex and isn't implemented with SCM
+ objects.
*/
-static ticket *
-suspend_guile ()
+
+static pthread_mutex_t ready_queue_mutex = PTHREAD_MUTEX_INITIALIZER;
+static scm_copt_thread *next_ready = NULL;
+static scm_copt_thread *last_ready = NULL;
+
+static void
+get_ready (scm_copt_thread *t)
{
- ticket *t = pthread_getspecific (ticket_key);
+ pthread_mutex_lock (&ready_queue_mutex);
+ t->next_ready = NULL;
+ if (last_ready)
+ last_ready->next_ready = t;
+ else
+ next_ready = t;
+ last_ready = t;
+ pthread_mutex_unlock (&ready_queue_mutex);
+}
- if (t == NULL)
- abort ();
+static scm_copt_thread *
+get_next_ready ()
+{
+ scm_copt_thread *t;
+ pthread_mutex_lock (&ready_queue_mutex);
+ t = next_ready;
+ if (t)
+ {
+ next_ready = t->next_ready;
+ if (next_ready == NULL)
+ last_ready = NULL;
+ }
+ return t;
+ pthread_mutex_unlock (&ready_queue_mutex);
+}
+
+/*** Running and sleeping */
+
+static SCM cur_thread;
+
+/* Kick the next runnable thread if there is one.
+ */
+static void
+kick_next ()
+{
+ scm_copt_thread *next = get_next_ready (ready_queue);
+ if (next)
+ pthread_cond_signal (&next->sleep_cond);
+}
+
+static SCM
+suspend ()
+{
+ SCM cur = cur_thread;
+ scm_copt_thread *c = SCM_THREAD_DATA (cur);
- /* Record top of stack...*/
- t->top = (SCM_STACKITEM *)&t;
- /* ...save registers for the GC...*/
+ /* record top of stack for the GC */
+ c->top = (SCM_STACKITEM *)&c;
+ /* save registers. */
SCM_FLUSH_REGISTER_WINDOWS;
- setjmp (t->regs);
+ setjmp (c->regs);
-#ifdef DEBUG
- fprintf (stderr, "thread %ld suspended\n", pthread_self ());
-#endif
+ return cur;
+}
- /* ... and leave temporarily. */
- guile_thread = 0;
+static void
+release ()
+{
pthread_mutex_unlock (&guile_mutex);
- return t;
}
-/* Resume the visit. This must be called from the same frame as the
- corresponding suspend_guile.
-*/
static void
-resume_guile (ticket *t)
+acquire ()
{
+ please = 1;
pthread_mutex_lock (&guile_mutex);
- guile_thread = pthread_self ();
-#ifdef DEBUG
- fprintf (stderr, "thread %ld resumed\n", pthread_self ());
-#endif
- t->top = NULL;
}
-static ticket main_ticket;
-
-int scm_switch_counter;
-
static void
-init_queue (scm_copt_queue *q)
+resume (SCM cur)
{
- q->first = NULL;
- q->lastp = &q->first;
+ scm_copt_thread *c = SCM_THREAD_DATA (cur);
+ cur_thread = cur;
+ c->top = NULL;
}
static void
-enqueue (scm_copt_queue *q, scm_copt_thread *t)
+block ()
{
- t->prevp = q->lastp;
- t->next = NULL;
- *t->prevp = t;
- q->lastp = &t->next;
+ SCM cur = suspend ();
+ scm_copt_thread *c = SCM_THREAD_DATA (cur);
+ pthread_cond_wait (&c->sleep_cond, &guile_mutex);
+ resume (cur);
}
-static scm_copt_thread *
-dequeue (scm_copt_queue *q)
+/* Yielding consists of getting the next thread from the ready_queue
+ and if there is one, putting ourselves on the ready queue and
+ block.
+*/
+SCM
+scm_yield ()
{
- scm_copt_thread *t = q->first;
- if (t)
+ scm_copt_thread *next = get_next_ready ();
+ if (next)
{
- *t->prevp = t->next;
- if (t->next)
- t->next->prevp = t->prevp;
- else
- q->lastp = t->prevp;
+ pthread_cond_signal (&next->sleep_cond);
+ get_ready (SCM_THREAD_DATA (cur_thread));
+ block ();
}
- return t;
+ return SCM_BOOL_T;
+}
+
+int scm_switch_counter;
+
+/*** Thread creation */
+
+static SCM all_threads;
+static int thread_count;
+
+typedef struct scheme_launch_data {
+ SCM rootcont;
+ SCM body;
+ SCM handler;
+} scheme_launch_data;
+
+static SCM
+scheme_body_bootstrip (scheme_launch_data* data)
+{
+ /* First save the new root continuation */
+ data->rootcont = scm_root->rootcont;
+ return scm_call_0 (data->body);
}
static SCM
-make_thread ()
+scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args)
{
- 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;
- return z;
+ scm_root->rootcont = data->rootcont;
+ return scm_apply_1 (data->handler, tag, throw_args);
}
static void
-init_thread_creator (SCM thread, pthread_t th, scm_root_state *r)
+really_launch (SCM_STACKITEM *base, SCM thread)
{
- scm_copt_thread *t = SCM_THREAD_DATA(thread);
- t->root = r;
- t->pthread = th;
- t->result = SCM_BOOL_F;
- pthread_cond_init (&t->block, NULL);
+ scm_copt_thread *t = SCM_THREAD_DATA (thread);
+ scheme_launch_data data;
+ init_thread_creatant (thread, base);
+ resume (thread);
+
+ /* Ok, we bullied our way in, now be nice and stand in queue.
+ */
+ scm_yield ();
+
+ data.rootcont = SCM_BOOL_F;
+ data.body = SCM_CAR (t->result);
+ data.handler = SCM_CADR (t->result);
+ t->result =
+ scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip,
+ &data,
+ (scm_t_catch_handler) scheme_handler_bootstrip,
+ &data, base);
+ pthread_detach (t->pthread);
+
+ {
+ SCM next = dequeue (ready_queue);
+ if (!SCM_FALSEP (next))
+ {
+ scm_copt_thread *n = SCM_THREAD_DATA (next);
+ pthread_cond_signal (&n->sleep_cond);
+ }
+ }
+
+ all_threads = scm_delq (thread, all_threads);
+ t->pthread = -1;
+ thread_count--;
+ suspend ();
}
-static void
-init_thread_creatant (SCM thread)
+static void *
+scheme_launch_thread (void *p)
{
- scm_copt_thread *t = SCM_THREAD_DATA(thread);
- pthread_setspecific (handle_key, t);
+ acquire ();
+ really_launch ((SCM_STACKITEM *)&p, (SCM)p);
+ release ();
+ return NULL;
+}
+
+
+SCM
+scm_call_with_new_thread (SCM argl)
+#define FUNC_NAME s_call_with_new_thread
+{
+ 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,
+ 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);
+ SCM_DEFER_INTS;
+ 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++;
+#ifdef DEBUG
+ fprintf (stderr, "thread %ld created\n", th);
+#endif
+ SCM_ALLOW_INTS;
+
+ /* Return to old dynamic context. */
+ scm_dowinds (old_winds, - scm_ilength (old_winds));
+ }
+
+ return thread;
}
+#undef FUNC_NAME
+
+/*** 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
+ asyncs) and we want to support waiting on many things at once.
+*/
+typedef struct scm_copt_mutex {
+ /* the thread currently owning the mutex, or SCM_BOOL_F. */
+ SCM owner;
+ /* how much the owner owns us. */
+ int level;
+ /* the threads waiting for this mutex. */
+ SCM waiting;
+} scm_copt_mutex;
static SCM
-thread_mark (SCM obj)
+mutex_mark (SCM mx)
{
- scm_copt_thread *t = SCM_THREAD_DATA (obj);
- scm_gc_mark (t->result);
- return t->root->handle;
+ scm_copt_mutex *m = SCM_MUTEX_DATA (mx);
+ scm_gc_mark (m->owner);
+ return m->waiting;
}
-static int
-thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
+SCM
+scm_make_mutex ()
{
- scm_copt_thread *t = SCM_THREAD_DATA (exp);
- scm_puts ("#<thread ", port);
- scm_intprint ((unsigned long)t, 16, port);
- if (t->pthread != -1)
+ SCM mx = scm_make_smob (scm_tc16_mutex);
+ scm_copt_mutex *m = SCM_MUTEX_DATA (mx);
+ m->owner = SCM_BOOL_F;
+ m->level = 0;
+ m->waiting = make_queue ();
+ return mx;
+}
+
+SCM
+scm_lock_mutex (SCM mx)
+#define FUNC_NAME s_lock_mutex
+{
+ scm_copt_mutex *m;
+ SCM_ASSERT (SCM_MUTEXP (mx), mx, SCM_ARG1, FUNC_NAME);
+ m = SCM_MUTEX_DATA (mx);
+
+ if (m->owner == SCM_BOOL_F)
+ m->owner = cur_thread;
+ else if (m->owner == cur_thread)
+ m->level++;
+ else
{
- scm_putc (' ', port);
- scm_intprint (t->pthread, 10, port);
+ while (m->owner != cur_thread)
+ {
+ enqueue (m->waiting, cur_thread);
+ kick_next ();
+ block ();
+ SCM_ASYNC_TICK;
+ }
}
- else
- scm_puts (" (exited)", port);
- scm_putc ('>', port);
- return 1;
+ return SCM_BOOL_T;
}
+#undef FUNC_NAME
-static size_t
-thread_free (SCM obj)
+SCM
+scm_unlock_mutex (SCM mx)
+#define FUNC_NAME s_lock_mutex
{
- scm_copt_thread *t = SCM_THREAD_DATA (obj);
- if (t->pthread != -1)
- abort ();
- scm_gc_free (t, sizeof (*t), "thread");
- return 0;
+ scm_copt_mutex *m;
+ SCM_ASSERT (SCM_MUTEXP (mx), mx, SCM_ARG1, FUNC_NAME);
+ 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 if (m->level > 0)
+ m->level--;
+ else
+ {
+ SCM next = dequeue (m->waiting);
+ if (!SCM_FALSEP (next))
+ {
+ m->owner = next;
+ enqueue (ready_queue, next);
+ scm_yield ();
+ }
+ else
+ m->owner = SCM_BOOL_F;
+ }
+ return SCM_BOOL_T;
}
+#undef FUNC_NAME
-static scm_copt_queue yield_queue;
+/*** Initialization */
void
scm_threads_init (SCM_STACKITEM *base)
{
- SCM main_thread;
- pthread_key_create (&handle_key, NULL);
- pthread_key_create (&ticket_key, NULL);
+ scm_tc16_thread = scm_make_smob_type ("thread", 0);
+ scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_copt_mutex));
+ scm_tc16_condvar = scm_make_smob_type ("condition-variable", 0);
+
scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
- enter_guile (base, &main_ticket);
- main_thread = make_thread ();
+
+ acquire ();
+ cur_thread = make_thread (SCM_BOOL_F);
/* root is set later from init.c */
- init_thread_creator (main_thread, pthread_self(), NULL);
- init_thread_creatant (main_thread);
- scm_gc_register_root (&all_threads);
- all_threads = scm_cons (main_thread, SCM_EOL);
+ init_thread_creator (cur_thread, pthread_self(), NULL);
+ init_thread_creatant (cur_thread, base);
+ resume (cur_thread);
thread_count = 1;
+ scm_gc_register_root (&all_threads);
+ all_threads = scm_cons (cur_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);
- init_queue (&yield_queue);
+
+ scm_set_smob_mark (scm_tc16_mutex, mutex_mark);
+
+ ready_queue = scm_permanent_object (make_queue ());
}
+/*** Marking stacks */
+
/* XXX - what to do with this? Do we need to handle this for blocked
threads as well?
*/
@@ -318,10 +590,15 @@ scm_threads_init (SCM_STACKITEM *base)
void
scm_threads_mark_stacks (void)
{
- ticket *t;
-
- for (t = tickets; t; t = t->next)
+ volatile SCM c;
+ for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c))
{
+ scm_copt_thread *t = SCM_THREAD_DATA (SCM_CAR (c));
+ if (t->base == NULL)
+ {
+ /* Not fully initialized yet. */
+ continue;
+ }
if (t->top == NULL)
{
/* Active thread */
@@ -388,138 +665,81 @@ scm_threads_mark_stacks (void)
}
}
-/* 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. */
+/*** Select */
-/* This is the first thread spawning mechanism: threads from Scheme */
+#include "libguile/iselect.h"
-typedef struct scheme_launch_data {
- SCM rootcont;
- SCM body;
- SCM handler;
-} scheme_launch_data;
+int
+scm_internal_select (int nfds,
+ SELECT_TYPE *readfds,
+ SELECT_TYPE *writefds,
+ SELECT_TYPE *exceptfds,
+ struct timeval *timeout)
+{
+ int res;
+ SCM cur = suspend ();
+ release ();
+ res = select (nfds, readfds, writefds, exceptfds, timeout);
+ acquire ();
+ resume (cur);
+ SCM_ASYNC_TICK;
+ return res;
+}
-static SCM
-scheme_body_bootstrip (scheme_launch_data* data)
+void
+scm_init_iselect ()
{
- /* First save the new root continuation */
- data->rootcont = scm_root->rootcont;
- return scm_call_0 (data->body);
}
-static SCM
-scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args)
+/*** Misc */
+
+SCM
+scm_current_thread (void)
{
- scm_root->rootcont = data->rootcont;
- return scm_apply_1 (data->handler, tag, throw_args);
+ return cur_thread;
}
-static void
-really_launch (void *p)
+SCM
+scm_all_threads (void)
{
- SCM argl = (SCM) p;
- SCM thread = SCM_CAR (argl);
- scm_copt_thread *t = SCM_THREAD_DATA (thread);
- SCM result;
- scheme_launch_data data;
- init_thread_creatant (thread);
- data.rootcont = SCM_BOOL_F;
- data.body = SCM_CADR (argl);
- data.handler = SCM_CADDR (argl);
- result = scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip,
- &data,
- (scm_t_catch_handler) scheme_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--;
+ return all_threads;
}
-static void *
-scheme_launch_thread (void *p)
+scm_root_state *
+scm_i_thread_root (SCM thread)
{
- ticket t;
- enter_guile ((SCM_STACKITEM *)&t, &t);
- really_launch (p);
- leave_guile (&t);
- return NULL;
+ return ((scm_copt_thread *)SCM_THREAD_DATA (thread))->root;
}
+void *
+scm_copt_thread_data (void)
+{
+ scm_copt_thread *t = SCM_THREAD_DATA (cur_thread);
+ return t->root;
+}
-SCM
-scm_call_with_new_thread (SCM argl)
-#define FUNC_NAME s_call_with_new_thread
+void
+scm_copt_set_thread_data (void *d)
{
- SCM thread;
+ scm_copt_thread *t = SCM_THREAD_DATA (cur_thread);
+ t->root = d;
+}
- /* 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 ();
- }
+/* XXX from here to end */
- /* Make new thread. The first thing the new thread will do is to
- call enter_guile. Thus, we can safely complete its
- initialization after creating it. */
- {
- pthread_t th;
- SCM root, old_winds;
-
- /* Unwind wind chain. */
- old_winds = scm_dynwinds;
- scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds));
+#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.
- /* Allocate thread locals. */
- root = scm_make_root (scm_root->handle);
- /* Make thread. */
- thread = make_thread ();
- SCM_DEFER_INTS;
- argl = scm_cons (thread, argl);
- /* Note that we couldn't pass a pointer to argl as data since the
- argl variable may not exist in memory when the thread starts. */
- pthread_create (&th, NULL, scheme_launch_thread, (void *) argl);
- init_thread_creator (thread, th, SCM_ROOT_STATE (root));
- all_threads = scm_cons (thread, all_threads);
- thread_count++;
-#ifdef DEBUG
- fprintf (stderr, "thread %ld created\n", th);
-#endif
- SCM_ALLOW_INTS;
+ 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 */
- /* Return to old dynamic context. */
- scm_dowinds (old_winds, - scm_ilength (old_winds));
- }
-
- return thread;
-}
-#undef FUNC_NAME
/* This is the second thread spawning mechanism: threads from C */
@@ -620,33 +840,13 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data,
return thread;
}
-
-SCM
-scm_current_thread (void)
-{
- scm_copt_thread *t = pthread_getspecific (handle_key);
- if (t == NULL)
- abort (); /* XXX - should ceate a new handle. */
- else
- return t->handle;
-}
-
-SCM
-scm_all_threads (void)
-{
- return all_threads;
-}
-
-scm_root_state *
-scm_i_thread_root (SCM thread)
-{
- return ((scm_copt_thread *)SCM_THREAD_DATA (thread))->root;
-}
+#endif
SCM
scm_join_thread (SCM thread)
#define FUNC_NAME s_join_thread
{
+#if 0
scm_copt_thread *t;
SCM res;
@@ -662,6 +862,8 @@ scm_join_thread (SCM thread)
res = t->result;
t->result = SCM_BOOL_F;
return res;
+#endif
+ return SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -677,209 +879,49 @@ scm_c_thread_exited_p (SCM thread)
#undef FUNC_NAME
SCM
-scm_yield (void)
-{
- fprintf (stderr, "yield\n");
- if (yield_queue.first)
- {
- ticket *t;
- scm_copt_thread *me = pthread_getspecific (handle_key);
- scm_copt_thread *next = dequeue (&yield_queue);
- enqueue (&yield_queue, me);
- pthread_cond_signal (&next->block);
- t = suspend_guile_2 ();
- pthread_cond_wait (&me->block, &guile_mutex);
- resume_guile_2 (t);
- }
- return SCM_BOOL_T;
-}
-
-void
-scm_copt_mutex_init (scm_copt_mutex *m)
-{
- pthread_mutex_init (&m->mutex, NULL);
- m->owner = NULL;
- m->level = 0;
- init_queue (&m->waiting);
-}
-
-void
-scm_copt_mutex_destroy (scm_copt_mutex *m)
-{
- pthread_mutex_destroy (&m->mutex);
-}
-
-void
-scm_copt_mutex_lock (scm_copt_mutex *m)
-{
- scm_copt_thread *t = pthread_getspecific (handle_key);
- pthread_mutex_lock (&m->mutex);
- if (m->owner == t)
- m->level++;
- else if (m->owner == NULL)
- {
- m->owner = t;
- }
- else
- {
- enqueue (&m->waiting, t);
- do
- {
- ticket *tt = suspend_guile ();
- pthread_cond_wait (&t->block, &m->mutex);
- resume_guile (tt);
- SCM_ASYNC_TICK;
- }
- while (m->owner != t);
- }
- pthread_mutex_unlock (&m->mutex);
-}
-
-void
-scm_copt_mutex_unlock (scm_copt_mutex *m)
-{
- pthread_mutex_lock (&m->mutex);
- if (m->level == 0)
- {
- scm_copt_thread *t = dequeue (&m->waiting);
- m->owner = t;
- if (t)
- pthread_cond_signal (&t->block);
- }
- else
- m->level--;
- pthread_mutex_unlock (&m->mutex);
-}
-
-SCM
-scm_make_mutex (void)
-{
- SCM m = scm_make_smob (scm_tc16_mutex);
- scm_copt_mutex_init (SCM_MUTEX_DATA (m));
- return m;
-}
-
-SCM
-scm_lock_mutex (SCM m)
-{
- ticket *t;
- SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
- t = suspend_guile ();
- scm_copt_mutex_lock (SCM_MUTEX_DATA (m));
- resume_guile (t);
- return SCM_BOOL_T;
-}
-
-SCM
-scm_unlock_mutex (SCM m)
-{
- SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
- scm_copt_mutex_unlock(SCM_MUTEX_DATA (m));
- return SCM_BOOL_T;
-}
-
-SCM
scm_make_condition_variable (void)
{
- SCM c = scm_make_smob (scm_tc16_condvar);
- pthread_cond_init (SCM_CONDVAR_DATA (c), NULL);
- return c;
+ abort ();
}
SCM
-scm_wait_condition_variable (SCM c, SCM m)
-{
- ticket *t;
- SCM_ASSERT (SCM_CONDVARP (c),
- c,
- SCM_ARG1,
- s_wait_condition_variable);
- SCM_ASSERT (SCM_MUTEXP (m),
- m,
- SCM_ARG2,
- s_wait_condition_variable);
- t = suspend_guile ();
- pthread_cond_wait (SCM_CONDVAR_DATA (c), SCM_MUTEX_DATA (m));
- resume_guile (t);
- return SCM_BOOL_T;
+scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
+{
+ abort ();
}
SCM
scm_signal_condition_variable (SCM c)
{
- SCM_ASSERT (SCM_CONDVARP (c),
- c,
- SCM_ARG1,
- s_signal_condition_variable);
- pthread_cond_signal (SCM_CONDVAR_DATA (c));
- return SCM_BOOL_T;
-}
-
-void *
-scm_copt_thread_data (void)
-{
- scm_copt_thread *t = pthread_getspecific (handle_key);
- if (t == NULL)
- abort ();
- else
- return t->root;
-}
-
-void
-scm_copt_set_thread_data (void *d)
-{
- scm_copt_thread *t = pthread_getspecific (handle_key);
- if (t == NULL)
- abort ();
- else
- t->root = d;
+ abort ();
}
unsigned long
scm_thread_usleep (unsigned long usec)
{
- ticket *t;
- unsigned long ret;
- t = suspend_guile ();
- ret = usleep (usec);
- resume_guile (t);
- return ret;
+ return usleep (usec);
}
unsigned long
scm_thread_sleep (unsigned long sec)
{
- ticket *t;
- unsigned long ret;
- t = suspend_guile ();
- ret = sleep (sec);
- resume_guile (t);
- return ret;
+ return sleep (sec);
}
-#include "libguile/iselect.h"
-int
-scm_internal_select (int nfds,
- SELECT_TYPE *readfds,
- SELECT_TYPE *writefds,
- SELECT_TYPE *exceptfds,
- struct timeval *timeout)
+SCM
+scm_try_mutex (SCM mx)
{
- ticket *t;
- int res;
- t = suspend_guile ();
- res = select (nfds, readfds, writefds, exceptfds, timeout);
- resume_guile (t);
- SCM_ASYNC_TICK;
- return res;
+ abort ();
}
-void
-scm_init_iselect ()
+SCM
+scm_broadcast_condition_variable (SCM cv)
{
+ abort ();
}
+
/*
Local Variables:
c-file-style: "gnu"