diff options
Diffstat (limited to 'libguile/coop-threads.c')
-rw-r--r-- | libguile/coop-threads.c | 439 |
1 files changed, 439 insertions, 0 deletions
diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c new file mode 100644 index 000000000..a8860fc62 --- /dev/null +++ b/libguile/coop-threads.c @@ -0,0 +1,439 @@ +/* Copyright (C) 1995, 1996 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, 675 Mass Ave, Cambridge, MA 02139, 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 "coop-threads.h" + +/* A counter of the current number of threads */ +size_t scm_thread_count = 0; + +/* This is included rather than compiled separately in order + to simplify the configuration mechanism. */ +#include "coop.c" + +/* A count-down counter used to determine when to switch + contexts */ +size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + +coop_m scm_critical_section_mutex; + +#ifdef __STDC__ +size_t +scm_threads_free_thread (SCM t) +#else +size_t +scm_threads_free_thread (t) + SCM t; +#endif +{ + scm_must_free (SCM_THREAD_DATA (t)); + return sizeof (coop_t); +} + +#ifdef __STDC__ +size_t +scm_threads_free_mutex (SCM m) +#else +size_t +scm_threads_free_mutex (m) + SCM m; +#endif +{ + scm_must_free (SCM_MUTEX_DATA (m)); + return sizeof (coop_m); +} + +#ifdef __STDC__ +size_t +scm_threads_free_condvar (SCM c) +#else +size_t +scm_threads_free_condvar (c) + SCM c; +#endif +{ + scm_must_free (SCM_CONDVAR_DATA (c)); + return sizeof (coop_c); +} + +#ifdef __STDC__ +void +scm_threads_init (SCM_STACKITEM *i) +#else +void +scm_threads_init (i) + SCM_STACKITEM *i; +#endif +{ + coop_init(); + + scm_thread_count = 1; + + coop_global_main.sto = i; + coop_global_main.base = i; + coop_global_curr = &coop_global_main; + coop_all_qput (&coop_global_allq, coop_global_curr); + + coop_mutex_init (&scm_critical_section_mutex); + + coop_global_main.data = 0; /* Initialized in init.c */ +} + +#ifdef __STDC__ +void +scm_threads_mark_stacks () +#else +void +scm_threads_mark_stacks () +#endif +{ + coop_t *thread; + + for (thread = coop_global_allq.t.all_next; + thread != NULL; thread = thread->all_next) + { + if (thread == coop_global_curr) + { + /* 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 *) (&thread) - + (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 values from SCM_LENGTH and SCM_CHARS 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, + ((scm_sizet) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations (((size_t) thread->base, + (sizet) stack_len)); +#else + long stack_len = ((SCM_STACKITEM *) thread->base - + (SCM_STACKITEM *) (&thread)); + + /* 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 values from SCM_LENGTH and SCM_CHARS 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, + ((scm_sizet) sizeof scm_save_regs_gc_mark + / sizeof (SCM_STACKITEM))); + + scm_mark_locations ((SCM_STACKITEM *) &thread, + stack_len); +#endif + } + else + { + /* Suspended thread */ +#ifdef STACK_GROWS_UP + long stack_len = ((SCM_STACKITEM *) (thread->sp) - + (SCM_STACKITEM *) thread->base); + + scm_mark_locations ((size_t)thread->base, + (sizet) stack_len); +#else + long stack_len = ((SCM_STACKITEM *) thread->base - + (SCM_STACKITEM *) (thread->sp)); + + /* Registers are already on the stack. No need to mark. */ + + scm_mark_locations ((SCM_STACKITEM *) (size_t)thread->sp, + stack_len); +#endif + } + + /* Mark this thread's root */ + scm_gc_mark (((scm_root_state *) thread->data) -> handle); + } +} + +#ifdef __STDC__ +void +launch_thread (void *p) +#else +void +launch_thread (p) + void *p; +#endif +{ + /* The thread object will be GC protected by being a member of the + list given as argument to launch_thread. It will be marked + during the conservative sweep of the stack. */ + SCM args = (SCM) p; + scm_call_with_dynamic_root (SCM_CADR (args), SCM_CADDR (args)); + scm_thread_count--; +} + +#ifdef __STDC__ +SCM +scm_call_with_new_thread (SCM argl) +#else +SCM +scm_call_with_new_thread (argl) + SCM argl; +#endif +{ + SCM thread; + + /* Check arguments. */ + { + register SCM args = argl; + SCM thunk, handler; + SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread); + thunk = SCM_CAR (args); + SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), + thunk, + SCM_ARG1, + s_call_with_new_thread); + args = SCM_CDR (args); + SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread); + handler = SCM_CAR (args); + SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), + handler, + SCM_ARG2, + s_call_with_new_thread); + SCM_ASSERT (SCM_NULLP (SCM_CDR (args)), argl, SCM_WNA, s_call_with_new_thread); + } + + /* Make new thread. */ + { + coop_t *t; + 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. */ + SCM_NEWCELL (thread); + SCM_DEFER_INTS; + SCM_SETCAR (thread, scm_tc16_thread); + argl = scm_cons (thread, argl); + t = coop_create (launch_thread, (void *) argl); + t->data = SCM_ROOT_STATE (root); + SCM_SETCDR (thread, t); + scm_thread_count++; + /* Note that the following statement also could cause coop_yield.*/ + SCM_ALLOW_INTS; + + /* We're now ready for the thread to begin. */ + coop_yield(); + + /* Return to old dynamic context. */ + scm_dowinds (old_winds, - scm_ilength (old_winds)); + } + + return thread; +} + +#ifdef __STDC__ +SCM +scm_join_thread (SCM t) +#else +SCM +scm_join_thread (t) + SCM t; +#endif +{ + SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_join_thread); + coop_join (SCM_THREAD_DATA (t)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_yield () +#else +SCM +scm_yield () +#endif +{ + /* Yield early */ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + coop_yield(); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_single_thread_p () +#else +SCM +scm_single_thread_p () +#endif +{ + return (coop_global_runq.tail == &coop_global_runq.t + ? SCM_BOOL_T + : SCM_BOOL_F); +} + +#ifdef __STDC__ +SCM +scm_make_mutex () +#else +SCM +scm_make_mutex () +#endif +{ + SCM m; + coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex"); + SCM_NEWCELL (m); + SCM_DEFER_INTS; + SCM_SETCAR (m, scm_tc16_mutex); + SCM_SETCDR (m, data); + SCM_ALLOW_INTS; + coop_mutex_init (data); + return m; +} + +#ifdef __STDC__ +SCM +scm_lock_mutex (SCM m) +#else +SCM +scm_lock_mutex (m) + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); + coop_mutex_lock (SCM_MUTEX_DATA (m)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_unlock_mutex (SCM m) +#else +SCM +scm_unlock_mutex (m) + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); + coop_mutex_unlock(SCM_MUTEX_DATA (m)); + + /* Yield early */ + scm_switch_counter = SCM_THREAD_SWITCH_COUNT; + coop_yield(); + + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_make_condition_variable () +#else +SCM +scm_make_condition_variable () +#endif +{ + SCM c; + coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar"); + SCM_NEWCELL (c); + SCM_DEFER_INTS; + SCM_SETCAR (c, scm_tc16_condvar); + SCM_SETCDR (c, data); + SCM_ALLOW_INTS; + coop_condition_variable_init (SCM_CONDVAR_DATA (c)); + return c; +} + +#ifdef __STDC__ +SCM +scm_wait_condition_variable (SCM c, SCM m) +#else +SCM +scm_wait_condition_variable (c, m) + SCM c; + SCM m; +#endif +{ + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_wait_condition_variable); + SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), + m, + SCM_ARG2, + s_wait_condition_variable); + coop_mutex_unlock (SCM_MUTEX_DATA (m)); + coop_condition_variable_wait (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_signal_condition_variable (SCM c) +#else +SCM +scm_signal_condition_variable (c) + SCM c; +#endif +{ + SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c), + c, + SCM_ARG1, + s_signal_condition_variable); + coop_condition_variable_signal (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} |