diff options
Diffstat (limited to 'libguile/threads.c')
-rw-r--r-- | libguile/threads.c | 292 |
1 files changed, 94 insertions, 198 deletions
diff --git a/libguile/threads.c b/libguile/threads.c index f440bf59d..2ca4f15e9 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -22,7 +22,7 @@ # include <config.h> #endif -#include "libguile/boehm-gc.h" +#include "libguile/bdw-gc.h" #include "libguile/_scm.h" #if HAVE_UNISTD_H @@ -53,6 +53,7 @@ #include "libguile/init.h" #include "libguile/scmsigs.h" #include "libguile/strings.h" +#include "libguile/weaks.h" #ifdef __MINGW32__ #ifndef ETIMEDOUT @@ -84,8 +85,14 @@ to_timespec (SCM t, scm_t_timespec *waittime) } } + /*** Queues */ +/* Note: We annotate with "GC-robust" assignments whose purpose is to avoid + the risk of false references leading to unbounded retained space as + described in "Bounding Space Usage of Conservative Garbage Collectors", + H.J. Boehm, 2001. */ + /* Make an empty queue data structure. */ static SCM @@ -128,6 +135,10 @@ remqueue (SCM q, SCM c) if (scm_is_eq (c, SCM_CAR (q))) SCM_SETCAR (q, SCM_CDR (c)); SCM_SETCDR (prev, SCM_CDR (c)); + + /* GC-robust */ + SCM_SETCDR (c, SCM_EOL); + SCM_CRITICAL_SECTION_END; return 1; } @@ -157,6 +168,10 @@ dequeue (SCM q) if (scm_is_null (SCM_CDR (q))) SCM_SETCAR (q, SCM_EOL); SCM_CRITICAL_SECTION_END; + + /* GC-robust */ + SCM_SETCDR (c, SCM_EOL); + return SCM_CAR (c); } } @@ -199,15 +214,7 @@ thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) return 1; } -static size_t -thread_free (SCM obj) -{ - scm_i_thread *t = SCM_I_THREAD_DATA (obj); - assert (t->exited); - scm_gc_free (t, sizeof (*t), "thread"); - return 0; -} - + /*** Blocking on queues. */ /* See also scm_i_queue_async_cell for how such a block is @@ -279,141 +286,31 @@ unblock_from_queue (SCM queue) return thread; } + /* Getting into and out of guile mode. */ -/* Ken Raeburn observes that the implementation of suspend and resume - (and the things that build on top of them) are very likely not - correct (see below). We will need fix this eventually, and that's - why scm_leave_guile/scm_enter_guile are not exported in the API. - - Ken writes: - - Consider this sequence: - - Function foo, called in Guile mode, calls suspend (maybe indirectly - through scm_leave_guile), which does this: - - // record top of stack for the GC - t->top = SCM_STACK_PTR (&t); // just takes address of automatic - var 't' - // save registers. - SCM_FLUSH_REGISTER_WINDOWS; // sparc only - SCM_I_SETJMP (t->regs); // here's most of the magic - - ... and returns. - - Function foo has a SCM value X, a handle on a non-immediate object, in - a caller-saved register R, and it's the only reference to the object - currently. - - The compiler wants to use R in suspend, so it pushes the current - value, X, into a stack slot which will be reloaded on exit from - suspend; then it loads stuff into R and goes about its business. The - setjmp call saves (some of) the current registers, including R, which - no longer contains X. (This isn't a problem for a normal - setjmp/longjmp situation, where longjmp would be called before - setjmp's caller returns; the old value for X would be loaded back from - the stack after the longjmp, before the function returned.) - - So, suspend returns, loading X back into R (and invalidating the jump - buffer) in the process. The caller foo then goes off and calls a - bunch of other functions out of Guile mode, occasionally storing X on - the stack again, but, say, much deeper on the stack than suspend's - stack frame went, and the stack slot where suspend had written X has - long since been overwritten with other values. - - Okay, nothing actively broken so far. Now, let garbage collection - run, triggered by another thread. - - The thread calling foo is out of Guile mode at the time, so the - garbage collector just scans a range of stack addresses. Too bad that - X isn't stored there. So the pointed-to storage goes onto the free - list, and I think you can see where things go from there. - - Is there anything I'm missing that'll prevent this scenario from - happening? I mean, aside from, "well, suspend and scm_leave_guile - don't have many local variables, so they probably won't need to save - any registers on most systems, so we hope everything will wind up in - the jump buffer and we'll just get away with it"? - - (And, going the other direction, if scm_leave_guile and suspend push - the stack pointer over onto a new page, and foo doesn't make further - function calls and thus the stack pointer no longer includes that - page, are we guaranteed that the kernel cannot release the now-unused - stack page that contains the top-of-stack pointer we just saved? I - don't know if any OS actually does that. If it does, we could get - faults in garbage collection.) - - I don't think scm_without_guile has to have this problem, as it gets - more control over the stack handling -- but it should call setjmp - itself. I'd probably try something like: - - // record top of stack for the GC - t->top = SCM_STACK_PTR (&t); - // save registers. - SCM_FLUSH_REGISTER_WINDOWS; - SCM_I_SETJMP (t->regs); - res = func(data); - scm_enter_guile (t); - - ... though even that's making some assumptions about the stack - ordering of local variables versus caller-saved registers. - - For something like scm_leave_guile to work, I don't think it can just - rely on invalidated jump buffers. A valid jump buffer, and a handle - on the stack state at the point when the jump buffer was initialized, - together, would work fine, but I think then we're talking about macros - invoking setjmp in the caller's stack frame, and requiring that the - caller of scm_leave_guile also call scm_enter_guile before returning, - kind of like pthread_cleanup_push/pop calls that have to be paired up - in a function. (In fact, the pthread ones have to be paired up - syntactically, as if they might expand to a compound statement - incorporating the user's code, and invoking a compiler's - exception-handling primitives. Which might be something to think - about for cases where Guile is used with C++ exceptions or - pthread_cancel.) -*/ +#ifdef SCM_HAVE_THREAD_STORAGE_CLASS -scm_i_pthread_key_t scm_i_thread_key; +/* When thread-local storage (TLS) is available, a pointer to the + current-thread object is kept in TLS. Note that storing the thread-object + itself in TLS (rather than a pointer to some malloc'd memory) is not + possible since thread objects may live longer than the actual thread they + represent. */ +SCM_THREAD_LOCAL scm_i_thread *scm_i_current_thread = NULL; -static void -resume (scm_i_thread *t) -{ - t->top = NULL; -} +# define SET_CURRENT_THREAD(_t) scm_i_current_thread = (_t) -typedef void* scm_t_guile_ticket; +#else /* !SCM_HAVE_THREAD_STORAGE_CLASS */ -static void -scm_enter_guile (scm_t_guile_ticket ticket) -{ - scm_i_thread *t = (scm_i_thread *)ticket; - if (t) - { - resume (t); - } -} +/* Key used to retrieve the current thread with `pthread_getspecific ()'. */ +scm_i_pthread_key_t scm_i_thread_key; -static scm_i_thread * -suspend (void) -{ - scm_i_thread *t = SCM_I_CURRENT_THREAD; +# define SET_CURRENT_THREAD(_t) \ + scm_i_pthread_setspecific (scm_i_thread_key, (_t)) - /* record top of stack for the GC */ - t->top = SCM_STACK_PTR (&t); - /* save registers. */ - SCM_FLUSH_REGISTER_WINDOWS; - SCM_I_SETJMP (t->regs); - return t; -} +#endif /* !SCM_HAVE_THREAD_STORAGE_CLASS */ -static scm_t_guile_ticket -scm_leave_guile () -{ - scm_i_thread *t = suspend (); - return (scm_t_guile_ticket) t; -} static scm_i_pthread_mutex_t thread_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; static scm_i_thread *all_threads = NULL; @@ -440,6 +337,7 @@ guilify_self_1 (SCM_STACKITEM *base) t->active_asyncs = SCM_EOL; t->block_asyncs = 1; t->pending_asyncs = 1; + t->critical_section_level = 0; t->last_debug_frame = NULL; t->base = base; #ifdef __ia64__ @@ -478,7 +376,7 @@ guilify_self_1 (SCM_STACKITEM *base) t->exited = 0; t->guile_mode = 0; - scm_i_pthread_setspecific (scm_i_thread_key, t); + SET_CURRENT_THREAD (t); scm_i_pthread_mutex_lock (&thread_admin_mutex); t->next_thread = all_threads; @@ -563,14 +461,18 @@ do_thread_exit (void *v) while (!scm_is_null (t->mutexes)) { - SCM mutex = SCM_CAR (t->mutexes); - fat_mutex *m = SCM_MUTEX_DATA (mutex); - scm_i_pthread_mutex_lock (&m->lock); + SCM mutex = SCM_WEAK_PAIR_CAR (t->mutexes); - unblock_from_queue (m->waiting); + if (!SCM_UNBNDP (mutex)) + { + fat_mutex *m = SCM_MUTEX_DATA (mutex); - scm_i_pthread_mutex_unlock (&m->lock); - t->mutexes = SCM_CDR (t->mutexes); + scm_i_pthread_mutex_lock (&m->lock); + unblock_from_queue (m->waiting); + scm_i_pthread_mutex_unlock (&m->lock); + } + + t->mutexes = SCM_WEAK_PAIR_CDR (t->mutexes); } scm_i_pthread_mutex_unlock (&t->admin_mutex); @@ -592,7 +494,7 @@ on_thread_exit (void *v) t->held_mutex = NULL; } - scm_i_pthread_setspecific (scm_i_thread_key, v); + SET_CURRENT_THREAD (v); /* Ensure the signal handling thread has been launched, because we might be shutting it down. */ @@ -614,6 +516,10 @@ on_thread_exit (void *v) if (*tp == t) { *tp = t->next_thread; + + /* GC-robust */ + t->next_thread = NULL; + break; } thread_count--; @@ -627,9 +533,11 @@ on_thread_exit (void *v) scm_i_pthread_mutex_unlock (&thread_admin_mutex); - scm_i_pthread_setspecific (scm_i_thread_key, NULL); + SET_CURRENT_THREAD (NULL); } +#ifndef SCM_HAVE_THREAD_STORAGE_CLASS + static scm_i_pthread_once_t init_thread_key_once = SCM_I_PTHREAD_ONCE_INIT; static void @@ -638,6 +546,8 @@ init_thread_key (void) scm_i_pthread_key_create (&scm_i_thread_key, NULL); } +#endif + /* Perform any initializations necessary to bring the current thread into guile mode, initializing Guile itself, if necessary. @@ -655,9 +565,12 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) { scm_i_thread *t; +#ifndef SCM_HAVE_THREAD_STORAGE_CLASS scm_i_pthread_once (&init_thread_key_once, init_thread_key); +#endif - if ((t = SCM_I_CURRENT_THREAD) == NULL) + t = SCM_I_CURRENT_THREAD; + if (t == NULL) { /* This thread has not been guilified yet. */ @@ -699,7 +612,7 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) t->base = base; #endif - scm_enter_guile ((scm_t_guile_ticket) t); + t->top = NULL; return 1; } else @@ -806,7 +719,6 @@ scm_with_guile (void *(*func)(void *), void *data) SCM_UNUSED static void scm_leave_guile_cleanup (void *x) { - scm_leave_guile (); on_thread_exit (SCM_I_CURRENT_THREAD); } @@ -823,7 +735,6 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) scm_i_pthread_cleanup_push (scm_leave_guile_cleanup, NULL); res = scm_c_with_continuation_barrier (func, data); scm_i_pthread_cleanup_pop (0); - scm_leave_guile (); } else res = scm_c_with_continuation_barrier (func, data); @@ -834,14 +745,18 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) /*** Non-guile mode. */ -#if (defined HAVE_GC_DO_BLOCKING) && (!defined HAVE_DECL_GC_DO_BLOCKING) +#ifdef HAVE_GC_DO_BLOCKING -/* This declaration is missing from the public headers of GC 7.1. */ -extern void GC_do_blocking (void (*) (void *), void *); +# ifndef HAVE_GC_FN_TYPE +/* This typedef is missing from the public headers of GC 7.1 and earlier. */ +typedef void * (* GC_fn_type) (void *); +# endif /* HAVE_GC_FN_TYPE */ -#endif +# ifndef HAVE_DECL_GC_DO_BLOCKING +/* This declaration is missing from the public headers of GC 7.1. */ +extern void GC_do_blocking (GC_fn_type, void *); +# endif /* HAVE_DECL_GC_DO_BLOCKING */ -#ifdef HAVE_GC_DO_BLOCKING struct without_guile_arg { void * (*function) (void *); @@ -861,7 +776,9 @@ without_guile_trampoline (void *closure) SCM_I_CURRENT_THREAD->guile_mode = 1; } -#endif + +#endif /* HAVE_GC_DO_BLOCKING */ + void * scm_without_guile (void *(*func)(void *), void *data) @@ -875,7 +792,7 @@ scm_without_guile (void *(*func)(void *), void *data) arg.function = func; arg.data = data; - GC_do_blocking (without_guile_trampoline, &arg); + GC_do_blocking ((GC_fn_type) without_guile_trampoline, &arg); result = arg.result; } else @@ -1215,7 +1132,6 @@ fat_mutex_free (SCM mx) { fat_mutex *m = SCM_MUTEX_DATA (mx); scm_i_pthread_mutex_destroy (&m->lock); - scm_gc_free (m, sizeof (fat_mutex), "mutex"); return 0; } @@ -1318,7 +1234,14 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) { scm_i_thread *t = SCM_I_THREAD_DATA (new_owner); scm_i_pthread_mutex_lock (&t->admin_mutex); - t->mutexes = scm_cons (mutex, t->mutexes); + + /* Only keep a weak reference to MUTEX so that it's not + retained when not referenced elsewhere (bug #27450). Note + that the weak pair itself it still retained, but it's better + than retaining MUTEX and the threads referred to by its + associated queue. */ + t->mutexes = scm_weak_car_pair (mutex, t->mutexes); + scm_i_pthread_mutex_unlock (&t->admin_mutex); } *ret = 1; @@ -1621,14 +1544,6 @@ SCM_DEFINE (scm_mutex_locked_p, "mutex-locked?", 1, 0, 0, } #undef FUNC_NAME -static size_t -fat_cond_free (SCM mx) -{ - fat_cond *c = SCM_CONDVAR_DATA (mx); - scm_gc_free (c, sizeof (fat_cond), "condition-variable"); - return 0; -} - static int fat_cond_print (SCM cv, SCM port, scm_print_state *pstate SCM_UNUSED) { @@ -1727,26 +1642,6 @@ SCM_DEFINE (scm_condition_variable_p, "condition-variable?", 1, 0, 0, } #undef FUNC_NAME -/*** Marking stacks */ - -/* 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 *) SCM_I_CURRENT_THREAD->register_backing_store_base; \ - top = (SCM_STACKITEM *) scm_ia64_ar_bsp (&ctx); \ - scm_mark_locations (bot, top - bot); } while (0) -#else -# define SCM_MARK_BACKING_STORE() -#endif - /*** Select */ @@ -1870,11 +1765,13 @@ scm_dynwind_pthread_mutex_lock (scm_i_pthread_mutex_t *mutex) int scm_pthread_cond_wait (scm_i_pthread_cond_t *cond, scm_i_pthread_mutex_t *mutex) { - scm_t_guile_ticket t = scm_leave_guile (); - ((scm_i_thread *)t)->held_mutex = mutex; - int res = scm_i_pthread_cond_wait (cond, mutex); - ((scm_i_thread *)t)->held_mutex = NULL; - scm_enter_guile (t); + int res; + scm_i_thread *t = SCM_I_CURRENT_THREAD; + + t->held_mutex = mutex; + res = scm_i_pthread_cond_wait (cond, mutex); + t->held_mutex = NULL; + return res; } @@ -1883,11 +1780,13 @@ scm_pthread_cond_timedwait (scm_i_pthread_cond_t *cond, scm_i_pthread_mutex_t *mutex, const scm_t_timespec *wt) { - scm_t_guile_ticket t = scm_leave_guile (); - ((scm_i_thread *)t)->held_mutex = mutex; - int res = scm_i_pthread_cond_timedwait (cond, mutex, wt); - ((scm_i_thread *)t)->held_mutex = NULL; - scm_enter_guile (t); + int res; + scm_i_thread *t = SCM_I_CURRENT_THREAD; + + t->held_mutex = mutex; + res = scm_i_pthread_cond_timedwait (cond, mutex, wt); + t->held_mutex = NULL; + return res; } @@ -1989,7 +1888,6 @@ static int threads_initialized_p = 0; /* This mutex is used by SCM_CRITICAL_SECTION_START/END. */ scm_i_pthread_mutex_t scm_i_critical_section_mutex; -int scm_i_critical_section_level = 0; static SCM dynwind_critical_section_mutex; @@ -2036,7 +1934,6 @@ scm_init_threads () { scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_i_thread)); scm_set_smob_print (scm_tc16_thread, thread_print); - scm_set_smob_free (scm_tc16_thread, thread_free); /* XXX: Could be removed */ scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (fat_mutex)); scm_set_smob_print (scm_tc16_mutex, fat_mutex_print); @@ -2045,7 +1942,6 @@ scm_init_threads () scm_tc16_condvar = scm_make_smob_type ("condition-variable", sizeof (fat_cond)); scm_set_smob_print (scm_tc16_condvar, fat_cond_print); - scm_set_smob_free (scm_tc16_condvar, fat_cond_free); scm_i_default_dynamic_state = SCM_BOOL_F; guilify_self_2 (SCM_BOOL_F); |