1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 07:40:30 +02:00

Convert mutexes, condition vars to statically-allocated tc16

* libguile/scm.h: Add statically allocated tc16s for condvars and
mutexes.
* libguile/threads.c: Adapt to declare tag inline to struct scm_cond and
struct scm_mutex.
* libguile/threads.h: Expose printing procedures internally.
* module/oop/goops.scm:
* libguile/goops.c: Fix to statically allocate condition variable and
mutex classes.
* libguile/eq.c:
* libguile/print.c: Adapt.
This commit is contained in:
Andy Wingo 2025-06-13 11:45:55 +02:00
parent 7a1406891f
commit f47fe6e752
7 changed files with 114 additions and 67 deletions

View file

@ -72,6 +72,15 @@
#include "threads.h"
#define SCM_MUTEXP(x) SCM_HAS_TYP16 (x, scm_tc16_mutex)
#define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condition_variable, x)
#define SCM_VALIDATE_CONDVAR(_pos, _obj) \
SCM_ASSERT_TYPE (SCM_CONDVARP (_obj), (_obj), (_pos), FUNC_NAME, "condvar")
#define SCM_VALIDATE_MUTEX(_pos, _obj) \
SCM_ASSERT_TYPE (SCM_MUTEXP (_obj), (_obj), (_pos), FUNC_NAME, "mutex")
#if 0
@ -952,7 +961,7 @@ enum scm_mutex_kind {
};
struct scm_mutex {
scm_i_pthread_mutex_t lock;
scm_t_bits tag_and_flags;
/* The thread that owns this mutex, or #f if the mutex is unlocked. */
SCM owner;
/* Queue of threads waiting for this mutex. */
@ -960,16 +969,32 @@ struct scm_mutex {
/* For SCM_MUTEX_RECURSIVE (and only SCM_MUTEX_RECURSIVE), the
recursive lock count. The first lock does not count. */
int level;
scm_i_pthread_mutex_t lock;
};
#define SCM_MUTEXP(x) SCM_SMOB_PREDICATE (scm_tc16_mutex, x)
#define SCM_MUTEX_DATA(x) ((struct scm_mutex *) SCM_SMOB_DATA (x))
#define SCM_MUTEX_KIND(x) ((enum scm_mutex_kind) (SCM_SMOB_FLAGS (x) & 0x3))
static int
scm_mutex_print (SCM mx, SCM port, scm_print_state *pstate SCM_UNUSED)
static struct scm_mutex*
scm_to_mutex (SCM x)
{
struct scm_mutex *m = SCM_MUTEX_DATA (mx);
if (!SCM_MUTEXP (x)) abort ();
return (struct scm_mutex*) SCM_UNPACK_POINTER (x);
}
static SCM
scm_from_mutex (struct scm_mutex *m)
{
return SCM_PACK_POINTER (m);
}
static enum scm_mutex_kind
mutex_kind (struct scm_mutex *m)
{
return m->tag_and_flags >> 16;
}
int
scm_i_print_mutex (SCM mx, SCM port, scm_print_state *pstate SCM_UNUSED)
{
struct scm_mutex *m = scm_to_mutex (mx);
scm_puts ("#<mutex ", port);
scm_uintprint ((scm_t_bits)m, 16, port);
scm_puts (">", port);
@ -1003,14 +1028,15 @@ SCM_DEFINE (scm_make_mutex_with_kind, "make-mutex", 0, 1, 0,
}
m = scm_gc_malloc (sizeof (struct scm_mutex), "mutex");
m->tag_and_flags = scm_tc16_mutex | (mkind << 16);
m->owner = SCM_BOOL_F;
m->waiting = make_queue ();
m->level = 0;
/* 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;
m->waiting = make_queue ();
return scm_new_smob (scm_tc16_mutex | (mkind << 16), (scm_t_bits) m);
return scm_from_mutex (m);
}
#undef FUNC_NAME
@ -1113,7 +1139,7 @@ SCM_DEFINE (scm_timed_lock_mutex, "lock-mutex", 1, 1, 0,
SCM ret;
SCM_VALIDATE_MUTEX (1, mutex);
m = SCM_MUTEX_DATA (mutex);
m = scm_to_mutex (mutex);
if (! SCM_UNBNDP (timeout) && ! scm_is_false (timeout))
{
@ -1123,7 +1149,7 @@ SCM_DEFINE (scm_timed_lock_mutex, "lock-mutex", 1, 1, 0,
/* Specialized lock_mutex implementations according to the mutex
kind. */
switch (SCM_MUTEX_KIND (mutex))
switch (mutex_kind (m))
{
case SCM_MUTEX_STANDARD:
ret = lock_mutex (SCM_MUTEX_STANDARD, m, t, waittime);
@ -1138,8 +1164,6 @@ SCM_DEFINE (scm_timed_lock_mutex, "lock-mutex", 1, 1, 0,
abort ();
}
scm_remember_upto_here_1 (mutex);
return ret;
}
#undef FUNC_NAME
@ -1220,11 +1244,11 @@ SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0, (SCM mutex),
SCM_VALIDATE_MUTEX (1, mutex);
m = SCM_MUTEX_DATA (mutex);
m = scm_to_mutex (mutex);
/* Specialized unlock_mutex implementations according to the mutex
kind. */
switch (SCM_MUTEX_KIND (mutex))
switch (mutex_kind (m))
{
case SCM_MUTEX_STANDARD:
unlock_mutex (SCM_MUTEX_STANDARD, m, t);
@ -1239,8 +1263,6 @@ SCM_DEFINE (scm_unlock_mutex, "unlock-mutex", 1, 0, 0, (SCM mutex),
abort ();
}
scm_remember_upto_here_1 (mutex);
return SCM_BOOL_T;
}
#undef FUNC_NAME
@ -1263,7 +1285,7 @@ SCM_DEFINE (scm_mutex_owner, "mutex-owner", 1, 0, 0,
struct scm_mutex *m = NULL;
SCM_VALIDATE_MUTEX (1, mx);
m = SCM_MUTEX_DATA (mx);
m = scm_to_mutex (mx);
scm_i_pthread_mutex_lock (&m->lock);
owner = m->owner;
scm_i_pthread_mutex_unlock (&m->lock);
@ -1278,9 +1300,10 @@ SCM_DEFINE (scm_mutex_level, "mutex-level", 1, 0, 0,
#define FUNC_NAME s_scm_mutex_level
{
SCM_VALIDATE_MUTEX (1, mx);
if (SCM_MUTEX_KIND (mx) == SCM_MUTEX_RECURSIVE)
return scm_from_int (SCM_MUTEX_DATA (mx)->level + 1);
else if (scm_is_eq (SCM_MUTEX_DATA (mx)->owner, SCM_BOOL_F))
struct scm_mutex *m = scm_to_mutex (mx);
if (mutex_kind (m) == SCM_MUTEX_RECURSIVE)
return scm_from_int (m->level + 1);
else if (scm_is_eq (m->owner, SCM_BOOL_F))
return SCM_INUM0;
else
return SCM_INUM1;
@ -1293,7 +1316,7 @@ SCM_DEFINE (scm_mutex_locked_p, "mutex-locked?", 1, 0, 0,
#define FUNC_NAME s_scm_mutex_locked_p
{
SCM_VALIDATE_MUTEX (1, mx);
if (scm_is_eq (SCM_MUTEX_DATA (mx)->owner, SCM_BOOL_F))
if (scm_is_eq (scm_to_mutex (mx)->owner, SCM_BOOL_F))
return SCM_BOOL_F;
else
return SCM_BOOL_T;
@ -1304,17 +1327,30 @@ SCM_DEFINE (scm_mutex_locked_p, "mutex-locked?", 1, 0, 0,
struct scm_cond {
scm_i_pthread_mutex_t lock;
scm_t_bits tag;
SCM waiting; /* the threads waiting for this condition. */
/* FIXME: Using one cond with multiple mutexes may race on the waiting
list. */
};
#define SCM_CONDVARP(x) SCM_SMOB_PREDICATE (scm_tc16_condvar, x)
#define SCM_CONDVAR_DATA(x) ((struct scm_cond *) SCM_SMOB_DATA (x))
static int
scm_cond_print (SCM cv, SCM port, scm_print_state *pstate SCM_UNUSED)
static struct scm_cond*
scm_to_condvar (SCM x)
{
struct scm_cond *c = SCM_CONDVAR_DATA (cv);
if (!SCM_CONDVARP (x)) abort ();
return (struct scm_cond*) SCM_UNPACK_POINTER (x);
}
static SCM
scm_from_condvar (struct scm_cond *c)
{
return SCM_PACK_POINTER (c);
}
int
scm_i_print_condition_variable (SCM cv, SCM port,
scm_print_state *pstate SCM_UNUSED)
{
struct scm_cond *c = scm_to_condvar (cv);
scm_puts ("#<condition-variable ", port);
scm_uintprint ((scm_t_bits)c, 16, port);
scm_puts (">", port);
@ -1326,14 +1362,11 @@ SCM_DEFINE (scm_make_condition_variable, "make-condition-variable", 0, 0, 0,
"Make a new condition variable.")
#define FUNC_NAME s_scm_make_condition_variable
{
struct scm_cond *c;
SCM cv;
c = scm_gc_malloc (sizeof (struct scm_cond), "condition variable");
c->waiting = SCM_EOL;
SCM_NEWSMOB (cv, scm_tc16_condvar, (scm_t_bits) c);
struct scm_cond *c =
scm_gc_malloc (sizeof (struct scm_cond), "condition variable");
c->tag = scm_tc16_condition_variable;
c->waiting = make_queue ();
return cv;
return scm_from_condvar (c);
}
#undef FUNC_NAME
@ -1455,8 +1488,8 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
SCM_VALIDATE_CONDVAR (1, cond);
SCM_VALIDATE_MUTEX (2, mutex);
c = SCM_CONDVAR_DATA (cond);
m = SCM_MUTEX_DATA (mutex);
c = scm_to_condvar (cond);
m = scm_to_mutex (mutex);
if (!SCM_UNBNDP (timeout))
{
@ -1466,7 +1499,7 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
/* Specialized timed_wait implementations according to the mutex
kind. */
switch (SCM_MUTEX_KIND (mutex))
switch (mutex_kind (m))
{
case SCM_MUTEX_STANDARD:
ret = timed_wait (SCM_MUTEX_STANDARD, m, c, t, waittime);
@ -1481,8 +1514,6 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1,
abort ();
}
scm_remember_upto_here_2 (mutex, cond);
return ret;
}
#undef FUNC_NAME
@ -1494,7 +1525,7 @@ SCM_DEFINE (scm_signal_condition_variable, "signal-condition-variable", 1, 0, 0,
{
struct scm_cond *c;
SCM_VALIDATE_CONDVAR (1, cv);
c = SCM_CONDVAR_DATA (cv);
c = scm_to_condvar (cv);
unblock_from_queue (c->waiting);
return SCM_BOOL_T;
}
@ -1507,7 +1538,7 @@ SCM_DEFINE (scm_broadcast_condition_variable, "broadcast-condition-variable", 1,
{
struct scm_cond *c;
SCM_VALIDATE_CONDVAR (1, cv);
c = SCM_CONDVAR_DATA (cv);
c = scm_to_condvar (cv);
while (scm_is_true (unblock_from_queue (c->waiting)))
;
return SCM_BOOL_T;
@ -1831,9 +1862,6 @@ scm_threads_prehistory (struct gc_mutator *mut, struct gc_stack_addr base)
guilify_self_1 (mut, base, 0);
}
scm_t_bits scm_tc16_mutex;
scm_t_bits scm_tc16_condvar;
static void
scm_init_ice_9_threads (void *unused)
{
@ -1853,13 +1881,6 @@ scm_init_ice_9_threads (void *unused)
void
scm_init_threads ()
{
scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (struct scm_mutex));
scm_set_smob_print (scm_tc16_mutex, scm_mutex_print);
scm_tc16_condvar = scm_make_smob_type ("condition-variable",
sizeof (struct scm_cond));
scm_set_smob_print (scm_tc16_condvar, scm_cond_print);
default_dynamic_state = SCM_BOOL_F;
guilify_self_2 (scm_i_make_initial_dynamic_state ());
threads_initialized_p = 1;