X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/228a24ef30e635e58af0e4fe5fc9b9db738abeff..eb7e1603ad497d0efff686e26e23af987c567721:/libguile/coop-threads.c diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index a3f4018e0..646aa8871 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -1,47 +1,24 @@ -/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. +/* 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. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * 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. + * This library 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 + * Lesser General Public License for more details. * - * 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. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ +#include "libguile/_scm.h" #include "libguile/validate.h" #include "libguile/coop-threads.h" #include "libguile/root.h" @@ -59,11 +36,18 @@ size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT; coop_m scm_critical_section_mutex; +static SCM all_threads; + void scm_threads_init (SCM_STACKITEM *i) { coop_init(); + scm_tc16_thread = scm_make_smob_type ("thread", 0); + scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (coop_m)); + scm_tc16_condvar = scm_make_smob_type ("condition-variable", + sizeof (coop_c)); + scm_thread_count = 1; #ifndef GUILE_PTHREAD_COMPAT @@ -76,6 +60,12 @@ scm_threads_init (SCM_STACKITEM *i) coop_mutex_init (&scm_critical_section_mutex); coop_global_main.data = 0; /* Initialized in init.c */ + + coop_global_main.handle = scm_cell (scm_tc16_thread, + (scm_t_bits) &coop_global_main); + + scm_gc_register_root (&all_threads); + all_threads = scm_cons (coop_global_main.handle, SCM_EOL); } void @@ -91,7 +81,7 @@ scm_threads_mark_stacks (void) /* Active thread */ /* stack_len is long rather than sizet in order to guarantee that &stack_len is long aligned */ -#ifdef STACK_GROWS_UP +#if SCM_STACK_GROWS_UP long stack_len = ((SCM_STACKITEM *) (&thread) - (SCM_STACKITEM *) thread->base); @@ -138,7 +128,7 @@ scm_threads_mark_stacks (void) else { /* Suspended thread */ -#ifdef STACK_GROWS_UP +#if SCM_STACK_GROWS_UP long stack_len = ((SCM_STACKITEM *) (thread->sp) - (SCM_STACKITEM *) thread->base); @@ -212,6 +202,7 @@ scheme_launch_thread (void *p) (SCM_STACKITEM *) &thread); SCM_SET_CELL_WORD_1 (thread, 0); scm_thread_count--; + all_threads = scm_delq (thread, all_threads); SCM_DEFER_INTS; } @@ -264,8 +255,10 @@ scm_call_with_new_thread (SCM argl) argl variable may not exist in memory when the thread starts. */ t = coop_create (scheme_launch_thread, (void *) argl); t->data = SCM_ROOT_STATE (root); + t->handle = thread; SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); scm_thread_count++; + all_threads = scm_cons (thread, all_threads); /* Note that the following statement also could cause coop_yield.*/ SCM_ALLOW_INTS; @@ -353,10 +346,11 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, data->handler_data = handler_data; t = coop_create (c_launch_thread, (void *) data); - t->data = SCM_ROOT_STATE (root); + t->handle = thread; SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t); scm_thread_count++; + all_threads = scm_cons (thread, all_threads); /* Note that the following statement also could cause coop_yield.*/ SCM_ALLOW_INTS; @@ -369,6 +363,24 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, return thread; } +SCM +scm_current_thread (void) +{ + return coop_global_curr->handle; +} + +SCM +scm_all_threads (void) +{ + return all_threads; +} + +scm_root_state * +scm_i_thread_root (SCM thread) +{ + return (scm_root_state *)((coop_t *)SCM_THREAD_DATA (thread))->data; +} + SCM scm_join_thread (SCM thread) #define FUNC_NAME s_join_thread @@ -388,10 +400,20 @@ scm_join_thread (SCM thread) if (thread_data) /* The thread is still alive */ coop_join (thread_data); + /* XXX - return real result. */ return SCM_BOOL_T; } #undef FUNC_NAME +int +scm_c_thread_exited_p (SCM thread) +#define FUNC_NAME s_scm_thread_exited_p +{ + SCM_VALIDATE_THREAD (1, thread); + return SCM_THREAD_DATA (thread) != NULL; +} +#undef FUNC_NAME + SCM scm_yield (void) { @@ -426,6 +448,13 @@ scm_lock_mutex (SCM m) return SCM_BOOL_T; } +SCM +scm_try_mutex (SCM m) +{ + SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); + return SCM_BOOL (coop_mutex_trylock (SCM_MUTEX_DATA (m))); +} + SCM scm_unlock_mutex (SCM m) { @@ -448,8 +477,13 @@ scm_make_condition_variable (void) } SCM -scm_wait_condition_variable (SCM c, SCM m) +scm_timed_wait_condition_variable (SCM c, SCM m, SCM t) +#define FUNC_NAME s_wait_condition_variable { + coop_c *cv; + coop_m *mx; + scm_t_timespec waittime; + SCM_ASSERT (SCM_CONDVARP (c), c, SCM_ARG1, @@ -458,10 +492,33 @@ scm_wait_condition_variable (SCM c, SCM m) m, SCM_ARG2, s_wait_condition_variable); - coop_condition_variable_wait_mutex (SCM_CONDVAR_DATA (c), - SCM_MUTEX_DATA (m)); - return SCM_BOOL_T; + + cv = SCM_CONDVAR_DATA (c); + mx = SCM_MUTEX_DATA (m); + + if (!SCM_UNBNDP (t)) + { + if (SCM_CONSP (t)) + { + SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec); + SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec); + waittime.tv_nsec *= 1000; + } + else + { + SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec); + waittime.tv_nsec = 0; + } + return SCM_BOOL( + coop_condition_variable_timed_wait_mutex (cv, mx, &waittime)); + } + else + { + coop_condition_variable_wait_mutex (cv, mx); + return SCM_BOOL_T; + } } +#undef FUNC_NAME SCM scm_signal_condition_variable (SCM c) @@ -474,6 +531,17 @@ scm_signal_condition_variable (SCM c) return SCM_BOOL_T; } +SCM +scm_broadcast_condition_variable (SCM c) +{ + SCM_ASSERT (SCM_CONDVARP (c), + c, + SCM_ARG1, + s_broadcast_condition_variable); + coop_condition_variable_broadcast (SCM_CONDVAR_DATA (c)); + return SCM_BOOL_T; +} + /* Local Variables: c-file-style: "gnu"