diff options
Diffstat (limited to 'libguile/threads.c')
-rw-r--r-- | libguile/threads.c | 301 |
1 files changed, 85 insertions, 216 deletions
diff --git a/libguile/threads.c b/libguile/threads.c index b84ddbdd6..f39bcc39e 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -25,6 +25,7 @@ #endif #include "libguile/bdw-gc.h" +#include <gc/gc_mark.h> #include "libguile/_scm.h" #include <stdlib.h> @@ -65,200 +66,42 @@ #include "libguile/init.h" #include "libguile/scmsigs.h" #include "libguile/strings.h" -#include "libguile/weaks.h" +#include "libguile/vm.h" #include <full-read.h> -/* First some libgc shims. */ +/* The GC "kind" for threads that allow them to mark their VM + stacks. */ +static int thread_gc_kind; -/* Make sure GC_fn_type is defined; it is missing from the public - headers of GC 7.1 and earlier. */ -#ifndef HAVE_GC_FN_TYPE -typedef void * (* GC_fn_type) (void *); -#endif - - -#ifndef GC_SUCCESS -#define GC_SUCCESS 0 -#endif - -#ifndef GC_UNIMPLEMENTED -#define GC_UNIMPLEMENTED 3 -#endif - -/* Likewise struct GC_stack_base is missing before 7.1. */ -#ifndef HAVE_GC_STACK_BASE -struct GC_stack_base { - void * mem_base; /* Base of memory stack. */ -#ifdef __ia64__ - void * reg_base; /* Base of separate register stack. */ -#endif -}; - -static int -GC_register_my_thread (struct GC_stack_base *stack_base) -{ - return GC_UNIMPLEMENTED; -} - -static void -GC_unregister_my_thread () +static struct GC_ms_entry * +thread_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr, + struct GC_ms_entry *mark_stack_limit, GC_word env) { -} + int word; + const struct scm_i_thread *t = (struct scm_i_thread *) addr; -#if !SCM_USE_PTHREAD_THREADS -/* No threads; we can just use GC_stackbottom. */ -static void * -get_thread_stack_base () -{ - return GC_stackbottom; -} + if (SCM_UNPACK (t->handle) == 0) + /* T must be on the free-list; ignore. (See warning in + gc_mark.h.) */ + return mark_stack_ptr; -#elif defined HAVE_PTHREAD_ATTR_GETSTACK && defined HAVE_PTHREAD_GETATTR_NP \ - && defined PTHREAD_ATTR_GETSTACK_WORKS -/* This method for GNU/Linux and perhaps some other systems. - It's not for MacOS X or Solaris 10, since pthread_getattr_np is not - available on them. */ -static void * -get_thread_stack_base () -{ - pthread_attr_t attr; - void *start, *end; - size_t size; + /* Mark T. We could be more precise, but it doesn't matter. */ + for (word = 0; word * sizeof (*addr) < sizeof (*t); word++) + mark_stack_ptr = GC_MARK_AND_PUSH ((void *) addr[word], + mark_stack_ptr, mark_stack_limit, + NULL); - pthread_getattr_np (pthread_self (), &attr); - pthread_attr_getstack (&attr, &start, &size); - end = (char *)start + size; + if (t->vp) + mark_stack_ptr = scm_i_vm_mark_stack (t->vp, mark_stack_ptr, + mark_stack_limit); -#if SCM_STACK_GROWS_UP - return start; -#else - return end; -#endif + return mark_stack_ptr; } -#elif defined HAVE_PTHREAD_GET_STACKADDR_NP -/* This method for MacOS X. - It'd be nice if there was some documentation on pthread_get_stackaddr_np, - but as of 2006 there's nothing obvious at apple.com. */ -static void * -get_thread_stack_base () -{ - return pthread_get_stackaddr_np (pthread_self ()); -} - -#elif HAVE_PTHREAD_ATTR_GET_NP -/* This one is for FreeBSD 9. */ -static void * -get_thread_stack_base () -{ - pthread_attr_t attr; - void *start, *end; - size_t size; - - pthread_attr_init (&attr); - pthread_attr_get_np (pthread_self (), &attr); - pthread_attr_getstack (&attr, &start, &size); - pthread_attr_destroy (&attr); - - end = (char *)start + size; - -#if SCM_STACK_GROWS_UP - return start; -#else - return end; -#endif -} - -#else -#error Threads enabled with old BDW-GC, but missing get_thread_stack_base impl. Please upgrade to libgc >= 7.1. -#endif - -static int -GC_get_stack_base (struct GC_stack_base *stack_base) -{ - stack_base->mem_base = get_thread_stack_base (); -#ifdef __ia64__ - /* Calculate and store off the base of this thread's register - backing store (RBS). Unfortunately our implementation(s) of - scm_ia64_register_backing_store_base are only reliable for the - main thread. For other threads, therefore, find out the current - top of the RBS, and use that as a maximum. */ - stack_base->reg_base = scm_ia64_register_backing_store_base (); - { - ucontext_t ctx; - void *bsp; - getcontext (&ctx); - bsp = scm_ia64_ar_bsp (&ctx); - if (stack_base->reg_base > bsp) - stack_base->reg_base = bsp; - } -#endif - return GC_SUCCESS; -} - -static void * -GC_call_with_stack_base(void * (*fn) (struct GC_stack_base*, void*), void *arg) -{ - struct GC_stack_base stack_base; - - stack_base.mem_base = (void*)&stack_base; -#ifdef __ia64__ - /* FIXME: Untested. */ - { - ucontext_t ctx; - getcontext (&ctx); - stack_base.reg_base = scm_ia64_ar_bsp (&ctx); - } -#endif - - return fn (&stack_base, arg); -} -#endif /* HAVE_GC_STACK_BASE */ - - -/* Now define with_gc_active and with_gc_inactive. */ - -#if (defined(HAVE_GC_DO_BLOCKING) && defined (HAVE_DECL_GC_DO_BLOCKING) && defined (HAVE_GC_CALL_WITH_GC_ACTIVE)) - -/* We have a sufficiently new libgc (7.2 or newer). */ - -static void* -with_gc_inactive (GC_fn_type func, void *data) -{ - return GC_do_blocking (func, data); -} - -static void* -with_gc_active (GC_fn_type func, void *data) -{ - return GC_call_with_gc_active (func, data); -} - -#else - -/* libgc not new enough, so never actually deactivate GC. - - Note that though GC 7.1 does have a GC_do_blocking, it doesn't have - GC_call_with_gc_active. */ - -static void* -with_gc_inactive (GC_fn_type func, void *data) -{ - return func (data); -} - -static void* -with_gc_active (GC_fn_type func, void *data) -{ - return func (data); -} - -#endif /* HAVE_GC_DO_BLOCKING */ - static void @@ -279,6 +122,7 @@ to_timespec (SCM t, scm_t_timespec *waittime) } } + /*** Queues */ @@ -400,11 +244,11 @@ thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) else id = u.um; - scm_puts ("#<thread ", port); + scm_puts_unlocked ("#<thread ", port); scm_uintprint (id, 10, port); - scm_puts (" (", port); + scm_puts_unlocked (" (", port); scm_uintprint ((scm_t_bits)t, 16, port); - scm_puts (")>", port); + scm_puts_unlocked (")>", port); return 1; } @@ -546,7 +390,9 @@ guilify_self_1 (struct GC_stack_base *base) t.held_mutex = NULL; t.join_queue = SCM_EOL; t.dynamic_state = SCM_BOOL_F; - t.dynwinds = SCM_EOL; + t.dynstack.base = NULL; + t.dynstack.top = NULL; + t.dynstack.limit = NULL; t.active_asyncs = SCM_EOL; t.block_asyncs = 1; t.pending_asyncs = 1; @@ -561,6 +407,7 @@ guilify_self_1 (struct GC_stack_base *base) t.sleep_mutex = NULL; t.sleep_object = SCM_BOOL_F; t.sleep_fd = -1; + t.vp = NULL; if (pipe2 (t.sleep_pipe, O_CLOEXEC) != 0) /* FIXME: Error conditions during the initialization phase are handled @@ -569,8 +416,6 @@ guilify_self_1 (struct GC_stack_base *base) abort (); scm_i_pthread_mutex_init (&t.admin_mutex, NULL); - t.current_mark_stack_ptr = NULL; - t.current_mark_stack_limit = NULL; t.canceled = 0; t.exited = 0; t.guile_mode = 0; @@ -580,7 +425,7 @@ guilify_self_1 (struct GC_stack_base *base) scm_i_thread *t_ptr = &t; GC_disable (); - t_ptr = GC_malloc (sizeof (scm_i_thread)); + t_ptr = GC_generic_malloc (sizeof (*t_ptr), thread_gc_kind); memcpy (t_ptr, &t, sizeof t); scm_i_pthread_setspecific (scm_i_thread_key, t_ptr); @@ -613,13 +458,16 @@ guilify_self_2 (SCM parent) t->continuation_root = scm_cons (t->handle, SCM_EOL); t->continuation_base = t->base; - t->vm = SCM_BOOL_F; if (scm_is_true (parent)) t->dynamic_state = scm_make_dynamic_state (parent); else t->dynamic_state = scm_i_make_initial_dynamic_state (); + t->dynstack.base = scm_gc_malloc (16 * sizeof (scm_t_bits), "dynstack"); + t->dynstack.limit = t->dynstack.base + 16; + t->dynstack.top = t->dynstack.base + SCM_DYNSTACK_HEADER_LEN; + t->join_queue = make_queue (); t->block_asyncs = 0; @@ -666,10 +514,6 @@ do_thread_exit (void *v) { scm_i_thread *t = (scm_i_thread *) v; - /* Ensure the signal handling thread has been launched, because we might be - shutting it down. This needs to be done in Guile mode. */ - scm_i_ensure_signal_delivery_thread (); - if (!scm_is_false (t->cleanup_handler)) { SCM ptr = t->cleanup_handler; @@ -690,9 +534,9 @@ do_thread_exit (void *v) while (!scm_is_null (t->mutexes)) { - SCM mutex = SCM_WEAK_PAIR_CAR (t->mutexes); + SCM mutex = scm_c_weak_vector_ref (scm_car (t->mutexes), 0); - if (!SCM_UNBNDP (mutex)) + if (scm_is_true (mutex)) { fat_mutex *m = SCM_MUTEX_DATA (mutex); @@ -707,7 +551,7 @@ do_thread_exit (void *v) scm_i_pthread_mutex_unlock (&m->lock); } - t->mutexes = SCM_WEAK_PAIR_CDR (t->mutexes); + t->mutexes = scm_cdr (t->mutexes); } scm_i_pthread_mutex_unlock (&t->admin_mutex); @@ -780,6 +624,12 @@ on_thread_exit (void *v) scm_i_pthread_setspecific (scm_i_thread_key, NULL); + if (t->vp) + { + scm_i_vm_free_stack (t->vp); + t->vp = NULL; + } + #if SCM_USE_PTHREAD_THREADS GC_unregister_my_thread (); #endif @@ -834,7 +684,7 @@ scm_i_init_thread_for_guile (struct GC_stack_base *base, SCM parent) */ scm_i_init_guile (base); -#if defined (HAVE_GC_ALLOW_REGISTER_THREADS) && SCM_USE_PTHREAD_THREADS +#if SCM_USE_PTHREAD_THREADS /* Allow other threads to come in later. */ GC_allow_register_threads (); #endif @@ -933,7 +783,7 @@ with_guile_and_parent (struct GC_stack_base *base, void *data) #endif t->guile_mode = 1; - res = with_gc_active (with_guile_trampoline, args); + res = GC_call_with_gc_active (with_guile_trampoline, args); t->guile_mode = 0; } return res; @@ -967,7 +817,7 @@ scm_without_guile (void *(*func)(void *), void *data) if (t->guile_mode) { SCM_I_CURRENT_THREAD->guile_mode = 0; - result = with_gc_inactive (func, data); + result = GC_do_blocking (func, data); SCM_I_CURRENT_THREAD->guile_mode = 1; } else @@ -1308,21 +1158,13 @@ SCM_DEFINE (scm_thread_p, "thread?", 1, 0, 0, #undef FUNC_NAME -static size_t -fat_mutex_free (SCM mx) -{ - fat_mutex *m = SCM_MUTEX_DATA (mx); - scm_i_pthread_mutex_destroy (&m->lock); - return 0; -} - static int fat_mutex_print (SCM mx, SCM port, scm_print_state *pstate SCM_UNUSED) { fat_mutex *m = SCM_MUTEX_DATA (mx); - scm_puts ("#<mutex ", port); + scm_puts_unlocked ("#<mutex ", port); scm_uintprint ((scm_t_bits)m, 16, port); - scm_puts (">", port); + scm_puts_unlocked (">", port); return 1; } @@ -1331,9 +1173,12 @@ make_fat_mutex (int recursive, int unchecked_unlock, int external_unlock) { fat_mutex *m; SCM mx; + scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; m = scm_gc_malloc (sizeof (fat_mutex), "mutex"); - scm_i_pthread_mutex_init (&m->lock, NULL); + /* Because PTHREAD_MUTEX_INITIALIZER is static, it's plain old data, + and so we can just copy it. */ + memcpy (&m->lock, &lock, sizeof (m->lock)); m->owner = SCM_BOOL_F; m->level = 0; @@ -1425,7 +1270,8 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) The weak pair itself is eventually removed when MUTEX is unlocked. Note that `t->mutexes' lists mutexes currently held by T, so it should be small. */ - t->mutexes = scm_weak_car_pair (mutex, t->mutexes); + t->mutexes = scm_cons (scm_make_weak_vector (SCM_INUM1, mutex), + t->mutexes); scm_i_pthread_mutex_unlock (&t->admin_mutex); } @@ -1570,6 +1416,25 @@ typedef struct { #define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condvar, x) #define SCM_CONDVAR_DATA(x) ((fat_cond *) SCM_SMOB_DATA (x)) +static void +remove_mutex_from_thread (SCM mutex, scm_i_thread *t) +{ + SCM walk, prev; + + for (prev = SCM_BOOL_F, walk = t->mutexes; scm_is_pair (walk); + walk = SCM_CDR (walk)) + { + if (scm_is_eq (mutex, scm_c_weak_vector_ref (SCM_CAR (walk), 0))) + { + if (scm_is_pair (prev)) + SCM_SETCDR (prev, SCM_CDR (walk)); + else + t->mutexes = SCM_CDR (walk); + break; + } + } +} + static int fat_mutex_unlock (SCM mutex, SCM cond, const scm_t_timespec *waittime, int relock) @@ -1614,7 +1479,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, if (m->level == 0) { /* Change the owner of MUTEX. */ - t->mutexes = scm_delq_x (mutex, t->mutexes); + remove_mutex_from_thread (mutex, t); m->owner = unblock_from_queue (m->waiting); } @@ -1648,7 +1513,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, } t->block_asyncs--; - scm_async_click (); + scm_async_tick (); scm_remember_upto_here_2 (cond, mutex); @@ -1662,7 +1527,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, if (m->level == 0) { /* Change the owner of MUTEX. */ - t->mutexes = scm_delq_x (mutex, t->mutexes); + remove_mutex_from_thread (mutex, t); m->owner = unblock_from_queue (m->waiting); } @@ -1758,9 +1623,9 @@ static int fat_cond_print (SCM cv, SCM port, scm_print_state *pstate SCM_UNUSED) { fat_cond *c = SCM_CONDVAR_DATA (cv); - scm_puts ("#<condition-variable ", port); + scm_puts_unlocked ("#<condition-variable ", port); scm_uintprint ((scm_t_bits)c, 16, port); - scm_puts (">", port); + scm_puts_unlocked (">", port); return 1; } @@ -2189,6 +2054,11 @@ scm_threads_prehistory (void *base) scm_i_pthread_mutex_init (&scm_i_misc_mutex, NULL); scm_i_pthread_cond_init (&wake_up_cond, NULL); + thread_gc_kind = + GC_new_kind (GC_new_free_list (), + GC_MAKE_PROC (GC_new_proc (thread_mark), 0), + 0, 1); + guilify_self_1 ((struct GC_stack_base *) base); } @@ -2204,7 +2074,6 @@ scm_init_threads () scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (fat_mutex)); scm_set_smob_print (scm_tc16_mutex, fat_mutex_print); - scm_set_smob_free (scm_tc16_mutex, fat_mutex_free); scm_tc16_condvar = scm_make_smob_type ("condition-variable", sizeof (fat_cond)); |