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:
parent
7a1406891f
commit
f47fe6e752
7 changed files with 114 additions and 67 deletions
|
@ -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;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue