From cf8ea1a3d1fcac51a4fa2676d46655a21f0bc50d Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 30 Oct 2002 10:41:51 +0000 Subject: [PATCH] Updated, but still totally unusable. --- libguile/coop-pthreads.c | 1010 ++++++++++++++++++++------------------ libguile/coop-pthreads.h | 54 -- 2 files changed, 526 insertions(+), 538 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,170 +54,48 @@ #undef DEBUG -static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER; -pthread_t guile_thread; +/* This thread implementation uses POSIX threads but allows only + thread to really execute at any one time. -static SCM all_threads; -static int thread_count; - -static pthread_key_t handle_key; - -/* 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. + XXX - more overview here. */ -typedef struct ticket { - struct ticket *next; - struct ticket **prevp; +/* All data is protected by a single mutex: guile_mutex. */ + +static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER; + +/*** Threads */ + +typedef struct scm_copt_thread { + + /* A condition variable for sleeping on. + */ + pthread_cond_t sleep_cond; + + /* A link for the ready queue. + */ + struct scm_copt_thread *next_ready; + + 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; - -/* 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) -{ - pthread_mutex_lock (&guile_mutex); - guile_thread = pthread_self (); - -#ifdef DEBUG - fprintf (stderr, "thread %ld entered\n", pthread_self ()); -#endif - - /* Ok, we are in. Stamp our ticket. */ - t->next = tickets; - if (tickets) - tickets->prevp = &t->next; - tickets = t; - t->prevp = &tickets; - - t->base = base; - t->top = NULL; - - pthread_setspecific (ticket_key, (void *)t); -} - -/* 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) -{ - /* Remove ticket... */ - *t->prevp = t->next; - if (t->next) - t->next->prevp = t->prevp; - -#ifdef DEBUG - fprintf (stderr, "thread %ld left\n", pthread_self ()); -#endif - - /* ...and leave. */ - guile_thread = 0; - pthread_mutex_unlock (&guile_mutex); -} - -/* 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 ticket * -suspend_guile () -{ - ticket *t = pthread_getspecific (ticket_key); - - if (t == NULL) - abort (); - - /* Record top of stack...*/ - t->top = (SCM_STACKITEM *)&t; - /* ...save registers for the GC...*/ - SCM_FLUSH_REGISTER_WINDOWS; - setjmp (t->regs); - -#ifdef DEBUG - fprintf (stderr, "thread %ld suspended\n", pthread_self ()); -#endif - - /* ... and leave temporarily. */ - guile_thread = 0; - 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) -{ - 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) -{ - q->first = NULL; - q->lastp = &q->first; -} - -static void -enqueue (scm_copt_queue *q, scm_copt_thread *t) -{ - t->prevp = q->lastp; - t->next = NULL; - *t->prevp = t; - q->lastp = &t->next; -} - -static scm_copt_thread * -dequeue (scm_copt_queue *q) -{ - scm_copt_thread *t = q->first; - if (t) - { - *t->prevp = t->next; - if (t->next) - t->next->prevp = t->prevp; - else - q->lastp = t->prevp; - } - return t; -} +} scm_copt_thread; static SCM -make_thread () +make_thread (SCM 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; + t->result = args; return z; } @@ -227,18 +105,17 @@ 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; - t->result = SCM_BOOL_F; - pthread_cond_init (&t->block, NULL); + pthread_cond_init (&t->sleep_cond, NULL); } static void -init_thread_creatant (SCM thread) +init_thread_creatant (SCM thread, SCM_STACKITEM *base) { scm_copt_thread *t = SCM_THREAD_DATA(thread); - pthread_setspecific (handle_key, t); + t->base = base; + t->top = NULL; } - static SCM thread_mark (SCM obj) { @@ -274,29 +151,424 @@ thread_free (SCM obj) return 0; } -static scm_copt_queue yield_queue; +/*** 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); +} + +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 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) +{ + 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); +} + +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 for the GC */ + c->top = (SCM_STACKITEM *)&c; + /* save registers. */ + SCM_FLUSH_REGISTER_WINDOWS; + setjmp (c->regs); + + return cur; +} + +static void +release () +{ + pthread_mutex_unlock (&guile_mutex); +} + +static void +acquire () +{ + please = 1; + pthread_mutex_lock (&guile_mutex); +} + +static void +resume (SCM cur) +{ + scm_copt_thread *c = SCM_THREAD_DATA (cur); + cur_thread = cur; + c->top = NULL; +} + +static void +block () +{ + SCM cur = suspend (); + scm_copt_thread *c = SCM_THREAD_DATA (cur); + pthread_cond_wait (&c->sleep_cond, &guile_mutex); + resume (cur); +} + +/* 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 *next = get_next_ready (); + if (next) + { + pthread_cond_signal (&next->sleep_cond); + get_ready (SCM_THREAD_DATA (cur_thread)); + block (); + } + 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 +scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args) +{ + scm_root->rootcont = data->rootcont; + return scm_apply_1 (data->handler, tag, throw_args); +} + +static void +really_launch (SCM_STACKITEM *base, SCM thread) +{ + 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 * +scheme_launch_thread (void *p) +{ + 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 +mutex_mark (SCM mx) +{ + scm_copt_mutex *m = SCM_MUTEX_DATA (mx); + scm_gc_mark (m->owner); + return m->waiting; +} + +SCM +scm_make_mutex () +{ + 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 + { + while (m->owner != cur_thread) + { + enqueue (m->waiting, cur_thread); + kick_next (); + block (); + SCM_ASYNC_TICK; + } + } + return SCM_BOOL_T; +} +#undef FUNC_NAME + +SCM +scm_unlock_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 != 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 + +/*** 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,6 +665,69 @@ scm_threads_mark_stacks (void) } } +/*** Select */ + +#include "libguile/iselect.h" + +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; +} + +void +scm_init_iselect () +{ +} + +/*** Misc */ + +SCM +scm_current_thread (void) +{ + return cur_thread; +} + +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; +} + +void * +scm_copt_thread_data (void) +{ + scm_copt_thread *t = SCM_THREAD_DATA (cur_thread); + return t->root; +} + +void +scm_copt_set_thread_data (void *d) +{ + scm_copt_thread *t = SCM_THREAD_DATA (cur_thread); + t->root = d; +} + +/* 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. @@ -400,126 +740,6 @@ scm_threads_mark_stacks (void) /* This is the first thread spawning mechanism: threads from Scheme */ -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 -scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args) -{ - scm_root->rootcont = data->rootcont; - return scm_apply_1 (data->handler, tag, throw_args); -} - -static void -really_launch (void *p) -{ - 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--; -} - -static void * -scheme_launch_thread (void *p) -{ - ticket t; - enter_guile ((SCM_STACKITEM *)&t, &t); - really_launch (p); - leave_guile (&t); - 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 - 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)); - - /* 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; - - /* 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 @@ -676,210 +878,50 @@ 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) +scm_timed_wait_condition_variable (SCM c, SCM m, SCM t) { - 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; + 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" diff --git a/libguile/coop-pthreads.h b/libguile/coop-pthreads.h index 194ad0b50..1f38a9464 100644 --- a/libguile/coop-pthreads.h +++ b/libguile/coop-pthreads.h @@ -63,12 +63,8 @@ #define SCM_THREAD_SWITCH_COUNT 50 -extern pthread_t guile_thread; /* for debugging */ - #define SCM_THREAD_SWITCHING_CODE \ do { \ - if (guile_thread != pthread_self ()) \ - abort (); \ scm_switch_counter--; \ if (scm_switch_counter == 0) \ { \ @@ -79,56 +75,6 @@ do { \ SCM_API int scm_switch_counter; -struct scm_copt_thread; - -typedef struct scm_copt_thread { - - /* A condition variable for sleeping on. - */ - pthread_cond_t block; - - scm_root_state *root; - SCM handle; - pthread_t pthread; - SCM result; - -} scm_copt_thread; - -/* 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 mutex for this data structure. */ - pthread_mutex_t mutex; - /* the thread currently owning the mutex, or NULL. */ - scm_copt_thread *owner; - /* how much the owner owns us. */ - int level; - /* the threads waiting for this mutex. */ - SCM waiting; -} scm_copt_mutex; - -typedef scm_copt_mutex scm_t_mutex; - -SCM_API void scm_copt_mutex_init (scm_copt_mutex *m); -SCM_API void scm_copt_mutex_lock (scm_copt_mutex *m); -SCM_API void scm_copt_mutex_unlock (scm_copt_mutex *m); -SCM_API void scm_copt_mutex_destroy (scm_copt_mutex *m); - -#define scm_mutex_init scm_copt_mutex_init -#define scm_mutex_lock scm_copt_mutex_lock -#define scm_mutex_unlock scm_copt_mutex_unlock -#define scm_mutex_destroy scm_copt_mutex_destroy - -typedef pthread_cond_t scm_t_cond; - -#define scm_cond_init(c) pthread_cond_init ((c), NULL) -#define scm_cond_wait pthread_cond_wait -#define scm_cond_signal pthread_cond_signal -#define scm_cond_broadcast pthread_cond_broadcast -#define scm_cond_destroy pthread_cond_destroy - #define SCM_THREAD_LOCAL_DATA (scm_copt_thread_data ()) #define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_copt_set_thread_data (ptr))