diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index ebbac076cb9..4003ab62073 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -172,6 +172,8 @@ struct caml_locking_scheme caml_default_locking_scheme = { &default_master_lock, (void (*)(void*))&st_masterlock_acquire, (void (*)(void*))&st_masterlock_release, + NULL, + NULL, (void (*)(void*))&st_masterlock_init, default_can_skip_yield, (void (*)(void*))&st_thread_yield }; @@ -649,6 +651,7 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg) caml_thread_t th = (caml_thread_t) arg; value clos; void * signal_stack; + struct caml_locking_scheme* sch; #ifdef NATIVE_CODE struct longjmp_buffer termination_buf; char tos; @@ -659,6 +662,9 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg) /* Associate the thread descriptor with the thread */ st_tls_set(thread_descriptor_key, (void *) th); st_thread_set_id(Ident(th->descr)); + sch = atomic_load(&caml_locking_scheme); + if (sch->thread_start != NULL) + sch->thread_start(sch->context, Thread_type_caml); /* Acquire the global mutex */ caml_leave_blocking_section(); st_thread_set_id(Ident(th->descr)); @@ -673,6 +679,9 @@ static ST_THREAD_FUNCTION caml_thread_start(void * arg) caml_modify(&(Start_closure(th->descr)), Val_unit); caml_callback_exn(clos, Val_unit); caml_thread_stop(); + sch = atomic_load(&caml_locking_scheme); + if (sch->thread_stop != NULL) + sch->thread_stop(sch->context, Thread_type_caml); #ifdef NATIVE_CODE } #endif @@ -722,10 +731,15 @@ CAMLprim value caml_thread_new(value clos) /* ML */ CAMLexport int caml_c_thread_register(void) { caml_thread_t th; + struct caml_locking_scheme* sch; #ifdef NATIVE_CODE st_retcode err; #endif + sch = atomic_load(&caml_locking_scheme); + if (sch->thread_start != NULL) + sch->thread_start(sch->context, Thread_type_c_registered); + /* Already registered? */ if (st_tls_get(thread_descriptor_key) != NULL) return 0; /* Create a thread info block */ @@ -767,6 +781,7 @@ CAMLexport int caml_c_thread_register(void) CAMLexport int caml_c_thread_unregister(void) { + struct caml_locking_scheme* sch; caml_thread_t th = st_tls_get(thread_descriptor_key); /* Not registered? */ if (th == NULL) return 0; @@ -781,6 +796,9 @@ CAMLexport int caml_c_thread_unregister(void) if (all_threads == NULL) caml_thread_cleanup(Val_unit); /* Release the runtime */ release_runtime_lock(); + sch = atomic_load(&caml_locking_scheme); + if (sch->thread_stop != NULL) + sch->thread_stop(sch->context, Thread_type_c_registered); return 1; } diff --git a/otherlibs/systhreads/threads.h b/otherlibs/systhreads/threads.h index 4b371c725f5..df6f7aa0e83 100644 --- a/otherlibs/systhreads/threads.h +++ b/otherlibs/systhreads/threads.h @@ -65,11 +65,19 @@ CAMLextern_libthreads int caml_c_thread_unregister(void); Both functions return 1 on success, 0 on error. */ +enum caml_thread_type { Thread_type_caml, Thread_type_c_registered }; struct caml_locking_scheme { void* context; void (*lock)(void*); void (*unlock)(void*); + /* If non-NULL, these functions are called when threads start and stop. + For threads created by OCaml, that's at creation and termination. + For threads created by C, that's at caml_c_thread_register/unregister. + The lock is not held when these functions are called. */ + void (*thread_start)(void*, enum caml_thread_type); + void (*thread_stop)(void*, enum caml_thread_type); + /* Called after fork(). The lock should be held after this function returns. */ void (*reinitialize_after_fork)(void*); diff --git a/testsuite/tests/lib-systhreads/swapgil.ml b/testsuite/tests/lib-systhreads/swapgil.ml index 829f439849e..2d9341e0a81 100644 --- a/testsuite/tests/lib-systhreads/swapgil.ml +++ b/testsuite/tests/lib-systhreads/swapgil.ml @@ -6,6 +6,9 @@ include systhreads *** native *) +external setup : unit -> unit = "swap_gil_setup" +let () = setup () + let counter = ref 0 external blocking_section : unit -> unit = "blocking_section" diff --git a/testsuite/tests/lib-systhreads/swapgil_stubs.c b/testsuite/tests/lib-systhreads/swapgil_stubs.c index 809c3abe4f0..44caae53b39 100644 --- a/testsuite/tests/lib-systhreads/swapgil_stubs.c +++ b/testsuite/tests/lib-systhreads/swapgil_stubs.c @@ -24,13 +24,18 @@ struct c_thread { pthread_t thread; }; +static __thread enum caml_thread_type thread_ty = Thread_type_caml; +static __thread int started = 0; void* threadfn(struct c_thread* th) { + thread_ty = Thread_type_c_registered; caml_c_thread_register(); caml_leave_blocking_section(); caml_callback(th->callback, Val_unit); caml_enter_blocking_section(); + if (!started) abort(); caml_c_thread_unregister(); + if (started) abort(); return NULL; } @@ -60,16 +65,19 @@ static void runtime_lock(void* m) timeout.tv_sec = 0; timeout.tv_usec = 1; select(0, NULL, NULL, NULL, &timeout); + if (!started) abort(); if (pthread_mutex_lock(m) != 0) abort(); } static void runtime_unlock(void* m) { + if (!started) abort(); if (pthread_mutex_unlock(m) != 0) abort(); } static void runtime_yield(void* m) { + if (!started) abort(); if (pthread_mutex_unlock(m) != 0) abort(); #ifdef __linux__ /* sched_yield() doesn't do what we want in Linux 2.6 and up (PR#2663) */ @@ -84,12 +92,31 @@ static void runtime_yield(void* m) if (pthread_mutex_lock(m) != 0) abort(); } +static void runtime_thread_start(void* m, enum caml_thread_type ty) +{ + if (ty != thread_ty) abort(); + started = 1; +} + +static void runtime_thread_stop(void* m, enum caml_thread_type ty) +{ + if (ty != thread_ty) abort(); + started = 0; +} + static void runtime_reinitialize(void* m) { /* This test doesn't fork, so this never runs. */ abort(); } +value swap_gil_setup(value unused) +{ + caml_default_locking_scheme.thread_start = runtime_thread_start; + caml_default_locking_scheme.thread_stop = runtime_thread_stop; + started = 1; +} + value swap_gil(value unused) { struct caml_locking_scheme* s; @@ -104,6 +131,8 @@ value swap_gil(value unused) s->context = m; s->lock = runtime_lock; s->unlock = runtime_unlock; + s->thread_start = runtime_thread_start; + s->thread_stop = runtime_thread_stop; s->reinitialize_after_fork = runtime_reinitialize; s->can_skip_yield = NULL; s->yield = runtime_yield;