mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 03:54:12 +02:00
Code Activity

Use Whippet API to boot threads

Browse source 
* libguile/scm.h (scm_tc7_thread): Give threads their own tc7.
* libguile/threads.h (struct scm_thread): Add a tag, so that struct
thread can be a SCM directly.  Add a struct gc_mutator* member.
(scm_thread_handle): New inline function.
(SCM_I_IS_THREAD, SCM_I_THREAD_DATA, SCM_VALIDATE_THREAD): Update to use
tc7 instead of SMOB tags.

* libguile/continuations.c (scm_i_with_continuation_barrier)
* libguile/finalizers.c (queue_finalizer_async)
* libguile/jit.c (compile_current_thread)
* libguile/threads.c (block_self, guilify_self_2)
(lock_mutex, unlock_mutex, timed_wait scm_current_thread)
(scm_all_threads)
* libguile/vm-engine.c (current-thread): Use scm_thread_handle instead
of thread->handle.

* libguile/evalext.c (scm_self_evaluating_p):
* libguile/goops.c (class_thread, scm_class_of, scm_sys_goops_early_init)
* libguile/print.c (iprin1)
* module/language/cps/compile-bytecode.scm (compile-function)
* module/oop/goops.scm (<thread>)
* module/system/base/types.scm (cell->object)
* module/system/base/types/internal.scm (heap-tags)
* module/system/vm/assembler.scm: (emit-thread?): Adapt to
scm_tc7_thread.

* libguile/gc-internal.h: Move init functions that take "struct
gc_stack_addr" here, so that internal Whippet uses don't cause Whippet
to be added to public headers.
* libguile/gc.c (scm_storage_prehistory): Take struct gc_stack_addr as
arg, and pass to gc_init.  Return a mutator pointer.
* libguile/init.c (scm_i_init_guile): Pass mutator and stack base to GC
and thread init routines.
* libguile/threads.c (scm_trace_dynstack, scm_trace_thread)
(scm_trace_thread_mutator_roots): New infra for marking threads in terms
of Whippet API.
* libguile/threads.c (guilify_self_1): Since we don't use a separate GC
kind for threads any more, and thread marking is keyed off
gc_mutator_set_roots, we can avoid some of the gnarly synchronization.
(on_thread_exit): Arrange to gc_finish_for_thread.
(scm_i_init_thread_for_guile): Use gc_init_for_thread.
(init_main_thread, with_guile, scm_i_with_guile): Use Whippet API.
(scm_threads_prehistory): Take main-thread mutator and the stack base as
arguments.
* libguile/vm.c (scm_trace_vm): Rework in terms of Whippet API.
* libguile/whippet-embedder.h (gc_trace_mutator_roots): Arrange to trace
the current mutator's SCM thread object.
* libguile/trace.h: New file, to declare implementations of trace
routines.
* libguile/Makefile.am (noinst_HEADERS): Add trace.h.
This commit is contained in:
Andy Wingo 2025-04-22 10:21:20 +02:00
parent 55e9d0672b
commit 27f0490801
25 changed files with 299 additions and 217 deletions
Download patch file Download diff file Expand all files Collapse all files

291
libguile/threads.c
View file

@ -49,7 +49,7 @@
#include "extensions.h"
#include "finalizers.h"
#include "fluids.h"
#include "gc-inline.h"
#include "gc-internal.h"
#include "gc.h"
#include "gsubr.h"
#include "hashtab.h"
@ -64,9 +64,11 @@
#include "scmsigs.h"
#include "strings.h"
#include "symbols.h"
#include "trace.h"
#include "variable.h"
#include "version.h"
#include "vm.h"
#include "whippet-embedder.h"
#include "threads.h"
@ -75,49 +77,72 @@
/* The GC "kind" for threads that allow them to mark their VM
stacks. */
static int thread_gc_kind;
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)
static void
scm_trace_dynstack (scm_t_dynstack *dynstack,
void (*trace_edge) (struct gc_edge edge,
struct gc_heap *heap,
void *trace_data),
struct gc_heap *heap, void *trace_data)
{
int word;
struct scm_thread *t = (struct scm_thread *) addr;
/* FIXME: Untagged array. Perhaps this should be off-heap... or
interleaved on the main stack. */
trace_edge (gc_edge (&dynstack->base), heap, trace_data);
}
if (SCM_UNPACK (t->handle) == 0)
/* T must be on the free-list; ignore. (See warning in
gc_mark.h.) */
return mark_stack_ptr;
void
scm_trace_thread (struct scm_thread *thread,
void (*trace_edge) (struct gc_edge edge,
struct gc_heap *heap,
void *trace_data),
struct gc_heap *heap, void *trace_data)
{
trace_edge (gc_edge (&thread->next_thread), heap, trace_data);
/* 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);
trace_edge (gc_edge (&thread->pending_asyncs), heap, trace_data);
/* The pointerless freelists are threaded through their first word,
but GC doesn't know to trace them (as they are pointerless), so we
need to do that here. See the comments at the top of libgc's
gc_inline.h. */
for (size_t n = 0; n < SCM_INLINE_GC_FREELIST_COUNT; n++)
{
void *chain = t->pointerless_freelists[n];
if (chain)
{
/* The first link is already marked by the thread itsel, so we
just have to mark the tail. */
while ((chain = *(void **)chain))
mark_stack_ptr = GC_mark_and_push (chain, mark_stack_ptr,
mark_stack_limit, NULL);
}
}
trace_edge (gc_edge (&thread->result), heap, trace_data);
mark_stack_ptr = scm_i_vm_mark_stack (&t->vm, mark_stack_ptr,
mark_stack_limit);
/* FIXME: This is not a tagged allocation. */
trace_edge (gc_edge (&thread->dynamic_state), heap, trace_data);
return mark_stack_ptr;
scm_trace_dynstack (&thread->dynstack, trace_edge, heap, trace_data);
trace_edge (gc_edge (&thread->continuation_root), heap, trace_data);
}
/* Guile-level thread objects are themselves GC-allocated. A thread
object has two states: active and finished. A thread is active if it
is attached to the gc_mutator_roots of a mutator. The thread has an
associated VM stack only during the active state.
Threads contain conservative roots, as the VM stack is only marked
partially precisely; it's possible that a frame doesn't have a stack
map for a given instruction pointer. This is the case for the hot
frame, but can also be the case for colder frames if there was a
per-instruction VM hook active. Therefore in a GC configuration that
only traces roots conservatively and assumes that intraheap edges are
precise, threads need to be traced during root identification.
*/
void
scm_trace_thread_mutator_roots (struct scm_thread *thread,
void (*trace_edge) (struct gc_edge edge,
struct gc_heap *heap,
void *trace_data),
struct gc_heap *heap, void *trace_data)
{
scm_trace_vm (&thread->vm, trace_edge, heap, trace_data);
/* FIXME: Remove these in favor of Whippet inline allocation. */
for (size_t i = 0; i < SCM_INLINE_GC_FREELIST_COUNT; i++)
trace_edge (gc_edge (&thread->freelists[i]), heap, trace_data);
for (size_t i = 0; i < SCM_INLINE_GC_FREELIST_COUNT; i++)
for (void **loc = &thread->pointerless_freelists[i];
*loc;
loc = (void **) *loc)
trace_edge (gc_edge (loc), heap, trace_data);
/* FIXME: Call instead via gc_trace_object. */
scm_trace_thread (thread, trace_edge, heap, trace_data);
}
@ -234,11 +259,8 @@ dequeue (SCM q)
}
}
/*** Thread smob routines */
static int
thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
int
scm_i_print_thread (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
/* On a Gnu system pthread_t is an unsigned long, but on mingw it's a
struct. A cast like "(unsigned long) t->pthread" is a syntax error in
@ -309,7 +331,7 @@ block_self (SCM queue, scm_i_pthread_mutex_t *mutex,
return EINTR;
t->block_asyncs++;
q_handle = enqueue (queue, t->handle);
q_handle = enqueue (queue, scm_thread_handle (t));
if (waittime == NULL)
err = scm_i_scm_pthread_cond_wait (&t->sleep_cond, mutex);
else
@ -370,64 +392,64 @@ static int thread_count;
static SCM default_dynamic_state;
struct scm_thread_and_roots
{
struct scm_thread thread;
struct gc_mutator_roots roots;
};
/* Perform first stage of thread initialisation, in non-guile mode.
*/
static void
guilify_self_1 (struct GC_stack_base *base, int needs_unregister)
guilify_self_1 (struct gc_mutator *mut, struct gc_stack_addr base,
int needs_unregister)
{
scm_thread t;
struct scm_thread_and_roots *thread_and_roots =
gc_allocate (mut, sizeof (*thread_and_roots), GC_ALLOCATION_TAGGED);
scm_thread *t = &thread_and_roots->thread;
struct gc_mutator_roots *roots = &thread_and_roots->roots;
/* We must arrange for SCM_I_CURRENT_THREAD to point to a valid value
before allocating anything in this thread, because allocation could
cause GC to run, and GC could cause finalizers, which could invoke
Scheme functions, which need the current thread to be set. */
/* We'll be referring to this object from thread-locals and other
places that are gnarly to relocate. */
gc_pin_object (mut, gc_ref_from_heap_object (t));
memset (&t, 0, sizeof (t));
t->tag = scm_tc7_thread;
t->pthread = scm_i_pthread_self ();
t->result = SCM_BOOL_F;
t->pending_asyncs = SCM_EOL;
t->block_asyncs = 1;
t->mutator = mut;
t->base = (SCM_STACKITEM *) gc_stack_addr_as_pointer (base);
t->continuation_root = SCM_EOL;
t->continuation_base = t->base;
scm_i_pthread_cond_init (&t->sleep_cond, NULL);
scm_i_vm_prepare_stack (&t->vm);
t.pthread = scm_i_pthread_self ();
t.handle = SCM_BOOL_F;
t.result = SCM_BOOL_F;
t.pending_asyncs = SCM_EOL;
t.block_asyncs = 1;
t.base = base->mem_base;
t.continuation_root = SCM_EOL;
t.continuation_base = t.base;
scm_i_pthread_cond_init (&t.sleep_cond, NULL);
scm_i_vm_prepare_stack (&t.vm);
if (pipe2 (t.sleep_pipe, O_CLOEXEC) != 0)
if (pipe2 (t->sleep_pipe, O_CLOEXEC) != 0)
/* FIXME: Error conditions during the initialization phase are handled
gracelessly since public functions such as `scm_init_guile ()'
currently have type `void'. */
abort ();
t.exited = 0;
t.guile_mode = 0;
t.needs_unregister = needs_unregister;
t->exited = 0;
t->guile_mode = 0;
t->needs_unregister = needs_unregister;
/* The switcheroo. */
{
scm_thread *t_ptr = &t;
GC_disable ();
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);
scm_i_pthread_setspecific (scm_i_thread_key, t);
#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
/* Cache the current thread in TLS for faster lookup. */
scm_i_current_thread = t_ptr;
/* Cache the current thread in TLS for faster lookup. */
scm_i_current_thread = t;
#endif
scm_i_pthread_mutex_lock (&thread_admin_mutex);
t_ptr->next_thread = all_threads;
all_threads = t_ptr;
thread_count++;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
roots->thread = t;
gc_mutator_set_roots (mut, roots);
GC_enable ();
}
scm_i_pthread_mutex_lock (&thread_admin_mutex);
t->next_thread = all_threads;
all_threads = t;
thread_count++;
scm_i_pthread_mutex_unlock (&thread_admin_mutex);
}
/* Perform second stage of thread initialisation, in guile mode.
@ -439,9 +461,7 @@ guilify_self_2 (SCM dynamic_state)
t->guile_mode = 1;
SCM_NEWSMOB (t->handle, scm_tc16_thread, t);
t->continuation_root = scm_cons (t->handle, SCM_EOL);
t->continuation_root = scm_cons (scm_thread_handle (t), SCM_EOL);
t->continuation_base = t->base;
t->dynamic_state = scm_gc_typed_calloc (scm_t_dynamic_state);
@ -469,6 +489,9 @@ on_thread_exit (void *v)
that isn't an issue as we have the all_threads list. */
scm_thread *t = (scm_thread *) v, **tp;
gc_finish_for_thread (t->mutator);
t->mutator = NULL;
t->exited = 1;
close (t->sleep_pipe[0]);
@ -488,10 +511,6 @@ on_thread_exit (void *v)
}
thread_count--;
/* Prevent any concurrent or future marker from visiting this
thread. */
t->handle = SCM_PACK (0);
/* If there's only one other thread, it could be the signal delivery
thread, in which case we should shut it down also by closing its
read pipe. */
@ -517,11 +536,6 @@ on_thread_exit (void *v)
#ifdef SCM_HAVE_THREAD_STORAGE_CLASS
scm_i_current_thread = NULL;
#endif
#if SCM_USE_PTHREAD_THREADS
if (t->needs_unregister)
GC_unregister_my_thread ();
#endif
}
static scm_i_pthread_once_t init_thread_key_once = SCM_I_PTHREAD_ONCE_INIT;
@ -549,8 +563,7 @@ init_thread_key (void)
be sure. New threads are put into guile mode implicitly. */
static int
scm_i_init_thread_for_guile (struct GC_stack_base *base,
SCM dynamic_state)
scm_i_init_thread_for_guile (struct gc_stack_addr base, SCM dynamic_state)
{
scm_i_pthread_once (&init_thread_key_once, init_thread_key);
@ -573,47 +586,36 @@ scm_i_init_thread_for_guile (struct GC_stack_base *base,
*/
scm_i_init_guile (base);
#if SCM_USE_PTHREAD_THREADS
/* Allow other threads to come in later. */
GC_allow_register_threads ();
#endif
scm_i_pthread_mutex_unlock (&scm_i_init_mutex);
}
else
{
int needs_unregister = 0;
/* Guile is already initialized, but this thread enters it for
the first time. Only initialize this thread.
*/
scm_i_pthread_mutex_unlock (&scm_i_init_mutex);
/* Register this thread with libgc. */
#if SCM_USE_PTHREAD_THREADS
if (GC_register_my_thread (base) == GC_SUCCESS)
needs_unregister = 1;
#endif
struct gc_mutator *mut = gc_init_for_thread (base, the_gc_heap);
int needs_unregister = 1;
guilify_self_1 (base, needs_unregister);
guilify_self_1 (mut, base, needs_unregister);
guilify_self_2 (dynamic_state);
}
return 1;
}
}
void
scm_init_guile ()
static void*
init_main_thread (struct gc_stack_addr base, void *unused)
{
struct GC_stack_base stack_base;
if (GC_get_stack_base (&stack_base) == GC_SUCCESS)
scm_i_init_thread_for_guile (&stack_base, default_dynamic_state);
else
{
fprintf (stderr, "Failed to get stack base for current thread.\n");
exit (EXIT_FAILURE);
}
scm_i_init_thread_for_guile (base, default_dynamic_state);
return NULL;
}
void
scm_init_guile (void)
{
gc_call_with_stack_addr (init_main_thread, NULL);
}
struct with_guile_args
@ -632,7 +634,7 @@ with_guile_trampoline (void *data)
}
static void *
with_guile (struct GC_stack_base *base, void *data)
with_guile (struct gc_stack_addr base, void *data)
{
void *res;
int new_thread;
@ -666,11 +668,11 @@ with_guile (struct GC_stack_base *base, void *data)
when this thread was first guilified. Thus, `base' must be
updated. */
#if SCM_STACK_GROWS_UP
if (SCM_STACK_PTR (base->mem_base) < t->base)
t->base = SCM_STACK_PTR (base->mem_base);
if (SCM_STACK_PTR (gc_stack_addr_as_pointer (base)) < t->base)
t->base = SCM_STACK_PTR (gc_stack_addr_as_pointer (base));
#else
if (SCM_STACK_PTR (base->mem_base) > t->base)
t->base = SCM_STACK_PTR (base->mem_base);
if (SCM_STACK_PTR (gc_stack_addr_as_pointer (base)) > t->base)
t->base = SCM_STACK_PTR (gc_stack_addr_as_pointer (base));
#endif
t->guile_mode = 1;
@ -689,7 +691,7 @@ scm_i_with_guile (void *(*func)(void *), void *data, SCM dynamic_state)
args.data = data;
args.dynamic_state = dynamic_state;
return GC_call_with_stack_base (with_guile, &args);
return gc_call_with_stack_addr (with_guile, &args);
}
void *
@ -1002,19 +1004,19 @@ lock_mutex (enum scm_mutex_kind kind, struct scm_mutex *m,
if (scm_is_eq (m->owner, SCM_BOOL_F))
{
m->owner = current_thread->handle;
m->owner = scm_thread_handle (current_thread);
scm_i_pthread_mutex_unlock (&m->lock);
return SCM_BOOL_T;
}
else if (kind == SCM_MUTEX_RECURSIVE &&
scm_is_eq (m->owner, current_thread->handle))
scm_is_eq (m->owner, scm_thread_handle (current_thread)))
{
m->level++;
scm_i_pthread_mutex_unlock (&m->lock);
return SCM_BOOL_T;
}
else if (kind == SCM_MUTEX_STANDARD &&
scm_is_eq (m->owner, current_thread->handle))
scm_is_eq (m->owner, scm_thread_handle (current_thread)))
{
scm_i_pthread_mutex_unlock (&m->lock);
SCM_MISC_ERROR ("mutex already locked by thread", SCM_EOL);
@ -1051,7 +1053,7 @@ lock_mutex (enum scm_mutex_kind kind, struct scm_mutex *m,
maybe_acquire:
if (scm_is_eq (m->owner, SCM_BOOL_F))
{
m->owner = current_thread->handle;
m->owner = scm_thread_handle (current_thread);
scm_i_pthread_mutex_unlock (&m->lock);
return SCM_BOOL_T;
}
@ -1138,7 +1140,7 @@ unlock_mutex (enum scm_mutex_kind kind, struct scm_mutex *m,
{
scm_i_scm_pthread_mutex_lock (&m->lock);
if (!scm_is_eq (m->owner, current_thread->handle))
if (!scm_is_eq (m->owner, scm_thread_handle (current_thread)))
{
if (scm_is_eq (m->owner, SCM_BOOL_F))
{
@ -1302,7 +1304,7 @@ timed_wait (enum scm_mutex_kind kind, struct scm_mutex *m, struct scm_cond *c,
{
scm_i_scm_pthread_mutex_lock (&m->lock);
if (!scm_is_eq (m->owner, current_thread->handle))
if (!scm_is_eq (m->owner, scm_thread_handle (current_thread)))
{
if (scm_is_eq (m->owner, SCM_BOOL_F))
{
@ -1354,7 +1356,7 @@ timed_wait (enum scm_mutex_kind kind, struct scm_mutex *m, struct scm_cond *c,
interrupts while reaquiring a mutex after a wait. */
current_thread->block_asyncs++;
if (kind == SCM_MUTEX_RECURSIVE &&
scm_is_eq (m->owner, current_thread->handle))
scm_is_eq (m->owner, scm_thread_handle (current_thread)))
{
m->level++;
scm_i_pthread_mutex_unlock (&m->lock);
@ -1364,7 +1366,7 @@ timed_wait (enum scm_mutex_kind kind, struct scm_mutex *m, struct scm_cond *c,
{
if (scm_is_eq (m->owner, SCM_BOOL_F))
{
m->owner = current_thread->handle;
m->owner = scm_thread_handle (current_thread);
scm_i_pthread_mutex_unlock (&m->lock);
break;
}
@ -1664,7 +1666,7 @@ SCM_DEFINE (scm_current_thread, "current-thread", 0, 0, 0,
"Return the thread that called this function.")
#define FUNC_NAME s_scm_current_thread
{
return SCM_I_CURRENT_THREAD->handle;
return scm_thread_handle (SCM_I_CURRENT_THREAD);
}
#undef FUNC_NAME
@ -1696,7 +1698,7 @@ SCM_DEFINE (scm_all_threads, "all-threads", 0, 0, 0,
&& !scm_i_is_signal_delivery_thread (t)
&& !scm_i_is_finalizer_thread (t))
{
SCM_SETCAR (*l, t->handle);
SCM_SETCAR (*l, scm_thread_handle (t));
l = SCM_CDRLOC (*l);
}
n--;
@ -1775,7 +1777,7 @@ pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1];
#endif
void
scm_threads_prehistory (void *base)
scm_threads_prehistory (struct gc_mutator *mut, struct gc_stack_addr base)
{
#if SCM_USE_PTHREAD_THREADS
pthread_mutexattr_init (scm_i_pthread_mutexattr_recursive);
@ -1786,15 +1788,9 @@ 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, 0);
guilify_self_1 (mut, base, 0);
}
scm_t_bits scm_tc16_thread;
scm_t_bits scm_tc16_mutex;
scm_t_bits scm_tc16_condvar;
@ -1817,9 +1813,6 @@ scm_init_ice_9_threads (void *unused)
void
scm_init_threads ()
{
scm_tc16_thread = scm_make_smob_type ("thread", sizeof (scm_thread));
scm_set_smob_print (scm_tc16_thread, thread_print);
scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (struct scm_mutex));
scm_set_smob_print (scm_tc16_mutex, scm_mutex_print);