X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/64e00566db6979144b3d151111e1128d4db15750..d5dffec4ffcb93ab649acb2b6f7d8a013ba0e10e:/libguile/null-threads.c diff --git a/libguile/null-threads.c b/libguile/null-threads.c dissimilarity index 97% index 41842a1b8..28eff2c61 100644 --- a/libguile/null-threads.c +++ b/libguile/null-threads.c @@ -1,319 +1,73 @@ -/* 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. */ - - - - -#include "libguile/validate.h" -#include "libguile/root.h" -#include "libguile/stackchk.h" -#include "libguile/async.h" -#include -#include -#include - -void *scm_null_threads_data; - -static SCM main_thread; - -void -scm_threads_init (SCM_STACKITEM *i) -{ - main_thread = scm_permanent_object (scm_cell (scm_tc16_thread, 0)); - scm_null_threads_data = NULL; -} - -#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) -{ - /* Mark objects on the C stack. */ - 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_STACKITEM) - 1 + - sizeof scm_save_regs_gc_mark) - / sizeof (SCM_STACKITEM))); - - { - unsigned long stack_len = scm_stack_size (scm_stack_base); -#ifdef SCM_STACK_GROWS_UP - scm_mark_locations (scm_stack_base, stack_len); -#else - scm_mark_locations (scm_stack_base - stack_len, stack_len); -#endif - } - SCM_MARK_BACKING_STORE(); -} - -SCM -scm_call_with_new_thread (SCM argl) -#define FUNC_NAME s_call_with_new_thread -{ - SCM_MISC_ERROR ("threads are not supported in this version of Guile", - SCM_EOL); - return SCM_BOOL_F; -} -#undef FUNC_NAME - -SCM -scm_spawn_thread (scm_t_catch_body body, void *body_data, - scm_t_catch_handler handler, void *handler_data) -{ - scm_misc_error ("scm_spawn_thread", - "threads are not supported in this version of Guile", - SCM_EOL); - return SCM_BOOL_F; -} - -SCM -scm_current_thread (void) -{ - return main_thread; -} - -SCM -scm_all_threads (void) -{ - return scm_list_1 (main_thread); -} - -scm_root_state * -scm_i_thread_root (SCM thread) -{ - return (scm_root_state *)scm_null_threads_data; -} - -SCM -scm_join_thread (SCM thread) -#define FUNC_NAME s_join_thread -{ - SCM_MISC_ERROR ("threads are not supported in this version of Guile", - SCM_EOL); - return SCM_BOOL_F; -} -#undef FUNC_NAME - -SCM -scm_yield (void) -{ - return SCM_BOOL_T; -} - -/* Block until a new async might have been queued. - */ -static void -block () -{ - select (0, NULL, NULL, NULL, NULL); -} - -int -scm_null_mutex_init (scm_null_mutex *m) -{ - m->locked = 0; - return 0; -} - -int -scm_null_mutex_lock (scm_null_mutex *m) -{ - while (m->locked) - { - block (); - SCM_ASYNC_TICK; - } - m->locked = 1; - return 1; -} - -int -scm_null_mutex_unlock (scm_null_mutex *m) -{ - if (m->locked == 0) - return 0; - m->locked = 0; - return 1; -} - -int -scm_null_mutex_destroy (scm_null_mutex *m) -{ - return 1; -} - -SCM -scm_make_mutex (void) -{ - SCM m = scm_make_smob (scm_tc16_mutex); - scm_null_mutex_init (SCM_MUTEX_DATA(m)); - return m; -} - -SCM -scm_lock_mutex (SCM m) -{ - SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex); - scm_null_mutex_lock (SCM_MUTEX_DATA(m)); - return SCM_BOOL_T; -} - -SCM -scm_unlock_mutex (SCM m) -{ - SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex); - if (!scm_null_mutex_unlock (SCM_MUTEX_DATA(m))) - scm_misc_error (s_unlock_mutex, "mutex is not locked", SCM_EOL); - return SCM_BOOL_T; -} - -int -scm_null_condvar_init (scm_null_condvar *c) -{ - c->signalled = 0; - return 0; -} - -int -scm_null_condvar_wait (scm_null_condvar *c, scm_null_mutex *m) -{ - scm_null_mutex_unlock (m); - while (!c->signalled) - { - block (); - SCM_ASYNC_TICK; - } - scm_null_mutex_lock (m); - c->signalled = 0; - return 0; -} - -int -scm_null_condvar_signal (scm_null_condvar *c) -{ - c->signalled = 1; - return 0; -} - -int -scm_null_condvar_destroy (scm_null_condvar *c) -{ - return 1; -} - -SCM -scm_make_condition_variable (void) -{ - SCM c = scm_make_smob (scm_tc16_condvar); - scm_null_condvar_init (SCM_CONDVAR_DATA (c)); - return c; -} - -SCM -scm_wait_condition_variable (SCM c, SCM m) -{ - SCM_ASSERT (SCM_CONDVARP (c), - c, - SCM_ARG1, - s_wait_condition_variable); - SCM_ASSERT (SCM_MUTEXP (m), - m, - SCM_ARG2, - s_wait_condition_variable); - scm_null_condvar_wait (SCM_CONDVAR_DATA (c), SCM_MUTEX_DATA (m)); - return SCM_BOOL_T; -} - -SCM -scm_signal_condition_variable (SCM c) -{ - SCM_ASSERT (SCM_CONDVARP (c), - c, - SCM_ARG1, - s_signal_condition_variable); - scm_null_condvar_signal (SCM_CONDVAR_DATA (c)); - return SCM_BOOL_T; -} - -unsigned long -scm_thread_usleep (unsigned long usec) -{ - struct timeval timeout; - timeout.tv_sec = 0; - timeout.tv_usec = usec; - select (0, NULL, NULL, NULL, &timeout); - return 0; /* Maybe we should calculate actual time slept, - but this is faster... :) */ -} - -unsigned long -scm_thread_sleep (unsigned long sec) -{ - time_t now = time (NULL); - struct timeval timeout; - unsigned long slept; - timeout.tv_sec = sec; - timeout.tv_usec = 0; - select (0, NULL, NULL, NULL, &timeout); - slept = time (NULL) - now; - return slept > sec ? 0 : sec - slept; -} - -/* - Local Variables: - c-file-style: "gnu" - End: -*/ +/* Copyright (C) 2002, 2006, 2008 Free Software Foundation, Inc. + * + * 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 3 of + * the License, or (at your option) any later version. + * + * 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. + * + * 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., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +#ifdef HAVE_CONFIG_H +# include +#endif + +#include +#include "libguile/_scm.h" + +#if SCM_USE_NULL_THREADS + +#include "libguile/null-threads.h" + +static scm_i_pthread_key_t *all_keys = NULL; + +static void +destroy_keys (void) +{ + scm_i_pthread_key_t *key; + int again; + + do { + again = 0; + for (key = all_keys; key; key = key->next) + if (key->value && key->destr_func) + { + void *v = key->value; + key->value = NULL; + key->destr_func (v); + again = 1; + } + } while (again); +} + +int +scm_i_pthread_key_create (scm_i_pthread_key_t *key, + void (*destr_func) (void *)) +{ + if (all_keys == NULL) + atexit (destroy_keys); + + key->next = all_keys; + all_keys = key; + key->value = NULL; + key->destr_func = destr_func; + + return 0; +} + +#endif /* SCM_USE_NULL_THREADS */ + + +/* + Local Variables: + c-file-style: "gnu" + End: +*/