diff options
author | Marius Vollmer <mvo@zagadka.de> | 2002-10-30 10:41:51 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2002-10-30 10:41:51 +0000 |
commit | cf8ea1a3d1fcac51a4fa2676d46655a21f0bc50d (patch) | |
tree | 1854efd7b781f25d1e5baa89bf5764d47d3a8fcb /libguile/coop-pthreads.c | |
parent | d703aba57ac1c35cdc1b995eba1d8e68a6799534 (diff) | |
download | guile-cf8ea1a3d1fcac51a4fa2676d46655a21f0bc50d.tar.gz |
Updated, but still totally unusable.
Diffstat (limited to 'libguile/coop-pthreads.c')
-rw-r--r-- | libguile/coop-pthreads.c | 974 |
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" |