summaryrefslogtreecommitdiff
path: root/libguile/threads.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/threads.c')
-rw-r--r--libguile/threads.c292
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);