diff options
author | Marius Vollmer <mvo@zagadka.de> | 2002-10-27 20:26:21 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2002-10-27 20:26:21 +0000 |
commit | d97eb496fc545f34d8709719b9e65b75537177ea (patch) | |
tree | b5f03004a25c538ee74ccd3d9c9138dbe1169d5b | |
parent | dbbaa07cabdb8b5225ed404497cdb9827e296917 (diff) | |
download | guile-d97eb496fc545f34d8709719b9e65b75537177ea.tar.gz |
* coop-pthreads.h, coop-pthreads.c: New, but unfinished.
-rw-r--r-- | libguile/coop-pthreads.c | 888 | ||||
-rw-r--r-- | libguile/coop-pthreads.h | 144 |
2 files changed, 1032 insertions, 0 deletions
diff --git a/libguile/coop-pthreads.c b/libguile/coop-pthreads.c new file mode 100644 index 000000000..a84d44fae --- /dev/null +++ b/libguile/coop-pthreads.c @@ -0,0 +1,888 @@ +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + + +#include <unistd.h> +#include <stdio.h> + +#include "libguile/validate.h" +#include "libguile/coop-pthreads.h" +#include "libguile/root.h" +#include "libguile/eval.h" +#include "libguile/async.h" +#include "libguile/ports.h" + +#undef DEBUG + +static pthread_mutex_t guile_mutex = PTHREAD_MUTEX_INITIALIZER; +pthread_t guile_thread; + +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. +*/ + +typedef struct ticket { + struct ticket *next; + struct ticket **prevp; + 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; +} + +static SCM +make_thread () +{ + 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; +} + +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; + t->result = SCM_BOOL_F; + pthread_cond_init (&t->block, NULL); +} + +static void +init_thread_creatant (SCM thread) +{ + scm_copt_thread *t = SCM_THREAD_DATA(thread); + pthread_setspecific (handle_key, t); +} + + +static SCM +thread_mark (SCM obj) +{ + scm_copt_thread *t = SCM_THREAD_DATA (obj); + scm_gc_mark (t->result); + return t->root->handle; +} + +static int +thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) +{ + 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; +} + +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; +} + +static scm_copt_queue yield_queue; + +void +scm_threads_init (SCM_STACKITEM *base) +{ + SCM main_thread; + pthread_key_create (&handle_key, NULL); + pthread_key_create (&ticket_key, NULL); + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + enter_guile (base, &main_ticket); + main_thread = make_thread (); + /* 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); + thread_count = 1; + 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); +} + +/* XXX - what to do with this? Do we need to handle this for blocked + threads as well? +*/ +#ifdef __ia64__ +# define SCM_MARK_BACKING_STORE() do { \ + ucontext_t ctx; \ + SCM_STACKITEM * top, * bot; \ + getcontext (&ctx); \ + scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ + ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ + / sizeof (SCM_STACKITEM))); \ + bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \ + top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \ + scm_mark_locations (bot, top - bot); } while (0) +#else +# define SCM_MARK_BACKING_STORE() +#endif + +void +scm_threads_mark_stacks (void) +{ + ticket *t; + + for (t = tickets; t; t = t->next) + { + if (t->top == NULL) + { + /* Active thread */ + /* stack_len is long rather than sizet in order to guarantee + that &stack_len is long aligned */ +#ifdef STACK_GROWS_UP + long stack_len = ((SCM_STACKITEM *) (&t) - + (SCM_STACKITEM *) thread->base); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the information about length and base address must + * remain usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ((size_t) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations (((size_t) t->base, + (sizet) stack_len)); +#else + long stack_len = ((SCM_STACKITEM *) t->base - + (SCM_STACKITEM *) (&t)); + + /* Protect from the C stack. This must be the first marking + * done because it provides information about what objects + * are "in-use" by the C code. "in-use" objects are those + * for which the information about length and base address must + * remain usable. This requirement is stricter than a liveness + * requirement -- in particular, it constrains the implementation + * of scm_resizuve. + */ + SCM_FLUSH_REGISTER_WINDOWS; + /* This assumes that all registers are saved into the jmp_buf */ + setjmp (scm_save_regs_gc_mark); + scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark, + ((size_t) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations ((SCM_STACKITEM *) &t, + stack_len); +#endif + } + else + { + /* Suspended thread */ +#ifdef STACK_GROWS_UP + long stack_len = t->top - t->base; + scm_mark_locations (t->base, stack_len); +#else + long stack_len = t->base - t->top; + scm_mark_locations (t->top, stack_len); +#endif + scm_mark_locations ((SCM_STACKITEM *) t->regs, + ((size_t) sizeof(t->regs) + / sizeof (SCM_STACKITEM))); + } + } +} + +/* 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 */ + +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 */ + +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; +} + +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; +} + +SCM +scm_join_thread (SCM thread) +#define FUNC_NAME s_join_thread +{ + scm_copt_thread *t; + SCM res; + + SCM_VALIDATE_THREAD (1, thread); + + t = SCM_THREAD_DATA (thread); + if (t->pthread != -1) + { + ticket *tt = suspend_guile (); + pthread_join (t->pthread, NULL); + resume_guile (tt); + } + res = t->result; + t->result = SCM_BOOL_F; + return res; +} +#undef FUNC_NAME + +int +scm_c_thread_exited_p (SCM thread) +#define FUNC_NAME s_scm_thread_exited_p +{ + scm_copt_thread *t; + SCM_VALIDATE_THREAD (1, thread); + t = SCM_THREAD_DATA (thread); + return t->pthread == -1; +} +#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; +} + +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 +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; +} + +unsigned long +scm_thread_usleep (unsigned long usec) +{ + ticket *t; + unsigned long ret; + t = suspend_guile (); + ret = usleep (usec); + resume_guile (t); + return ret; +} + +unsigned long +scm_thread_sleep (unsigned long sec) +{ + ticket *t; + unsigned long ret; + t = suspend_guile (); + ret = sleep (sec); + resume_guile (t); + return ret; +} + +#include "libguile/iselect.h" + +int +scm_internal_select (int nfds, + SELECT_TYPE *readfds, + SELECT_TYPE *writefds, + SELECT_TYPE *exceptfds, + struct timeval *timeout) +{ + ticket *t; + int res; + t = suspend_guile (); + res = select (nfds, readfds, writefds, exceptfds, timeout); + resume_guile (t); + SCM_ASYNC_TICK; + return res; +} + +void +scm_init_iselect () +{ +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ + diff --git a/libguile/coop-pthreads.h b/libguile/coop-pthreads.h new file mode 100644 index 000000000..194ad0b50 --- /dev/null +++ b/libguile/coop-pthreads.h @@ -0,0 +1,144 @@ +/* classes: h_files */ + +#ifndef SCM_COOP_PTHREADS_H +#define SCM_COOP_PTHREADS_H + +/* Copyright (C) 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +/* The coop-pthreads implementation. We provide implement threads, + mutices and condition variables using the pthread ones, but only + one thread can ever be active inside Guile at any one time. +*/ + +#include <pthread.h> + +/* Since only one thread can be active anyway, we don't need to do + anything special around critical sections. In fact, that's the + reason we do only support cooperative threading: Guile's critical + regions have not been completely identified yet. (I think.) */ + +#define SCM_CRITICAL_SECTION_START +#define SCM_CRITICAL_SECTION_END + +#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) \ + { \ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; \ + scm_yield(); \ + } \ +} while (0) + +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)) + +SCM_API void *scm_copt_thread_data (void); +SCM_API void scm_copt_set_thread_data (void *); + +#endif /* SCM_COOP_PTHREAD_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ |