diff options
Diffstat (limited to 'libguile/mit-pthreads.c')
-rw-r--r-- | libguile/mit-pthreads.c | 495 |
1 files changed, 495 insertions, 0 deletions
diff --git a/libguile/mit-pthreads.c b/libguile/mit-pthreads.c new file mode 100644 index 000000000..d58912c39 --- /dev/null +++ b/libguile/mit-pthreads.c @@ -0,0 +1,495 @@ +/* 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. + */ + + +typedef struct scm_pthread_info { + queue q; /* the dequeue on which this structure exists */ + /* reqired to be the first element */ + pthread_t thread; /* the corresponding thread structure */ + void *stack_top; /* the highest address in this thread's stack */ + scm_root_state *root; /* root for this thread */ +} scm_pthread_info; + +pthread_mutex_t scm_critical_section_mutex; +pthread_t scm_critical_section_owner; + +static queue infos = { &infos, &infos }; /* the dequeue of info structures */ + +/* Key to thread specific data */ +pthread_key_t info_key; + +#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 (pthread_t); +} + +#ifdef __STDC__ +size_t +scm_threads_free_mutex (SCM m) +#else +size_t +scm_threads_free_mutex (m) + SCM m; +#endif +{ + pthread_mutex_destroy (SCM_MUTEX_DATA (m)); + scm_must_free (SCM_MUTEX_DATA (m)); + return sizeof (pthread_mutex_t); +} + +#ifdef __STDC__ +size_t +scm_threads_free_condvar (SCM c) +#else +size_t +scm_threads_free_condvar (c) + SCM c; +#endif +{ + pthread_cond_destroy (SCM_CONDVAR_DATA (c)); + scm_must_free (SCM_CONDVAR_DATA (c)); + return sizeof (pthread_cond_t); +} + +/* cleanup for info structure + */ +#ifdef __STDC__ +static void +scm_pthread_delete_info (void *ptr) +#else +static void +scm_pthread_delete_info (ptr) + void *ptr; +#endif +{ + scm_pthread_info *info = (scm_pthread_info *) ptr; + info->q.blink->flink = info->q.flink; + info->q.flink->blink = info->q.blink; + scm_must_free ((char *) info); +} + +#ifdef __STDC__ +void +scm_threads_init (SCM_STACKITEM *i) +#else +void +scm_threads_init (i) + SCM_STACKITEM *i; +#endif +{ + /* + * each info structure is made thread-specific, so that the cleanup + * mechanism can be used to reclaim the space in a timely fashion. + */ + pthread_key_create (&info_key, scm_pthread_delete_info); + + /* initialize various mutex variables */ + pthread_mutex_init (&scm_critical_section_mutex, NULL); + + /* + * create an info structure for the initial thread and push it onto + * the info dequeue + */ + { + scm_pthread_info *info; + info = (scm_pthread_info *) scm_must_malloc (sizeof (scm_pthread_info), + "threads_init"); + infos.flink = infos.blink = &info->q; + info->q.flink = info->q.blink = &infos; + info->thread = pthread_initial; + info->stack_top = (void *) i; + pthread_setspecific(info_key, info); + } + /* The root state pointer gets initialized in init.c. */ +} + +/* given some thread, find the corresponding info + */ +static scm_pthread_info *pthreads_find_info (pthread_t target) +{ + queue *ptr = infos.flink; + + while (ptr != &infos) + { + scm_pthread_info *info = (scm_pthread_info *) ptr; + + if (info->thread == target) + { + return (info); + } + ptr = ptr->flink; + } +} + +#ifdef __STDC__ +void +scm_threads_mark_stacks () +#else +void +scm_threads_mark_stacks () +#endif +{ + scm_pthread_info *info; + pthread_t thread; + int j; + + for (info = (scm_pthread_info *) infos.flink; + info != (scm_pthread_info *) &infos; + info = (scm_pthread_info *) info->q.flink) + { + thread = info->thread; + if (thread == pthread_run) + { + /* 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 *) info->stack_top); + + /* 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) info->stack_top, + (sizet) stack_len)); +#else + long stack_len = ((SCM_STACKITEM *) info->stack_top - + (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->THREAD_SP) - + (SCM_STACKITEM *) info->stack_top); + + scm_mark_locations ((size_t)info->stack_top, + (sizet) stack_len); +#else + long stack_len = ((SCM_STACKITEM *) info->stack_top - + (SCM_STACKITEM *) (thread->THREAD_SP)); + + scm_mark_locations ((SCM_STACKITEM *) thread->machdep_data.machdep_state, + ((scm_sizet) sizeof (*thread->machdep_data.machdep_state) + / sizeof (SCM_STACKITEM))); + scm_mark_locations ((SCM_STACKITEM *) (size_t) thread->THREAD_SP, + stack_len); +#endif + } + + /* Mark this thread's root */ + scm_gc_mark (((scm_root_state *) info->root) -> 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; + pthread_attr_setcleanup (&pthread_self () -> attr, + NULL, + SCM_ROOT_STATE (SCM_CAR (args))); + scm_call_with_dynamic_root (SCM_CADDR (args), SCM_CADDDR (args)); + return NULL; +} + +#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. */ + { + pthread_attr_t attr; + pthread_t t; + scm_pthread_info *info = + (scm_pthread_info *) scm_must_malloc (sizeof (scm_pthread_info), + "pthread_info"); + 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_cons2 (root, thread, argl); + + /* thread mustn't start until we've built the info struct */ + pthread_kernel_lock++; + + /* initialize and create the thread. */ + pthread_attr_init (&attr); + pthread_attr_setschedpolicy (&attr, SCHED_RR); + + pthread_create (&t, &attr, launch_thread, (void *) argl); + pthread_attr_destroy (&attr); + + /* push the info onto the dequeue */ + info->q.flink = infos.flink; + info->q.blink = &infos; + infos.flink->blink = &info->q; + infos.flink = &info->q; + /* pthread_create filled in the initial SP -- profitons-en ! */ + info->stack_top = (void *) (t->THREAD_SP); + info->thread = t; + info->root = SCM_ROOT_STATE (root); + SCM_SETCDR (thread, t); + SCM_ALLOW_INTS; + + /* we're now ready for the thread to begin */ + pthread_kernel_lock--; + + /* 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 +{ + void *value; + pthread_join (SCM_THREAD_DATA (t), &value); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_yield () +#else +SCM +scm_yield () +#endif +{ + pthread_yield (); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_make_mutex () +#else +SCM +scm_make_mutex () +#endif +{ + SCM m; + pthread_mutex_t *data = (pthread_mutex_t *) scm_must_malloc (sizeof (pthread_mutex_t), "mutex"); + SCM_NEWCELL (m); + SCM_DEFER_INTS; + SCM_SETCAR (m, scm_tc16_mutex); + SCM_SETCDR (m, data); + SCM_ALLOW_INTS; + pthread_mutex_init (SCM_MUTEX_DATA (m), NULL); + 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); + pthread_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); + pthread_mutex_unlock (SCM_MUTEX_DATA (m)); + return SCM_BOOL_T; +} + +#ifdef __STDC__ +SCM +scm_make_condition_variable () +#else +SCM +scm_make_condition_variable () +#endif +{ + SCM c; + pthread_cond_t *data = (pthread_cond_t *) scm_must_malloc (sizeof (pthread_cond_t), "condvar"); + SCM_NEWCELL (c); + SCM_DEFER_INTS; + SCM_SETCAR (c, scm_tc16_condvar); + SCM_SETCDR (c, data); + SCM_ALLOW_INTS; + pthread_cond_init (SCM_CONDVAR_DATA (c), NULL); + 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); + pthread_cond_wait (SCM_CONDVAR_DATA (m), SCM_MUTEX_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); + pthread_cond_signal (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} |