mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-03 08:10:31 +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
parent
7a1406891f
commit
f47fe6e752
7 changed files with 114 additions and 67 deletions
|
|
@ -388,6 +388,9 @@ scm_equal_p (SCM x, SCM y)
|
|||
{
|
||||
case scm_tc16_charset:
|
||||
return scm_from_bool (scm_i_char_sets_equal (x, y));
|
||||
case scm_tc16_condition_variable:
|
||||
case scm_tc16_mutex:
|
||||
return SCM_BOOL_F;
|
||||
default:
|
||||
abort ();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -139,6 +139,8 @@ static SCM class_finalizer;
|
|||
static SCM class_ephemeron;
|
||||
static SCM class_ephemeron_table;
|
||||
static SCM class_character_set;
|
||||
static SCM class_condition_variable;
|
||||
static SCM class_mutex;
|
||||
|
||||
static struct scm_ephemeron_table *vtable_class_map;
|
||||
static SCM pre_goops_vtables = SCM_EOL;
|
||||
|
|
@ -345,6 +347,10 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
|||
{
|
||||
case scm_tc16_charset:
|
||||
return class_character_set;
|
||||
case scm_tc16_condition_variable:
|
||||
return class_condition_variable;
|
||||
case scm_tc16_mutex:
|
||||
return class_mutex;
|
||||
default:
|
||||
abort ();
|
||||
}
|
||||
|
|
@ -980,6 +986,8 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
|
|||
class_ephemeron = scm_variable_ref (scm_c_lookup ("<ephemeron>"));
|
||||
class_ephemeron_table = scm_variable_ref (scm_c_lookup ("<ephemeron-table>"));
|
||||
class_character_set = scm_variable_ref (scm_c_lookup ("<character-set>"));
|
||||
class_condition_variable = scm_variable_ref (scm_c_lookup ("<condition-variable>"));
|
||||
class_mutex = scm_variable_ref (scm_c_lookup ("<mutex>"));
|
||||
|
||||
create_smob_classes ();
|
||||
create_struct_classes ();
|
||||
|
|
|
|||
|
|
@ -792,6 +792,12 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
|||
case scm_tc16_charset:
|
||||
scm_i_print_char_set (exp, port, pstate);
|
||||
break;
|
||||
case scm_tc16_condition_variable:
|
||||
scm_i_print_condition_variable (exp, port, pstate);
|
||||
break;
|
||||
case scm_tc16_mutex:
|
||||
scm_i_print_mutex (exp, port, pstate);
|
||||
break;
|
||||
default:
|
||||
abort ();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -509,6 +509,19 @@ typedef uintptr_t scm_t_bits;
|
|||
|
||||
/* Objects with scm_tc7_ext. */
|
||||
#define scm_tc16_charset 0x007f
|
||||
#define scm_tc16_condition_variable 0x017f
|
||||
#define scm_tc16_mutex 0x027f
|
||||
/*
|
||||
#define scm_tc16_continuation 0x067f
|
||||
#define scm_tc16_directory 0x077f
|
||||
#define scm_tc16_hook 0x097f
|
||||
#define scm_tc16_macro 0x0a7f
|
||||
#define scm_tc16_malloc 0x0b7f
|
||||
#define scm_tc16_port_with_print_state 0x0d7f
|
||||
#define scm_tc16_promise 0x0e7f
|
||||
#define scm_tc16_random_state 0x0f7f
|
||||
#define scm_tc16_regexp 0x107f
|
||||
*/
|
||||
|
||||
/* Definitions for tc16: */
|
||||
#define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x))
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -52,10 +52,6 @@
|
|||
|
||||
|
||||
|
||||
/* smob tags for the thread datatypes */
|
||||
SCM_API scm_t_bits scm_tc16_mutex;
|
||||
SCM_API scm_t_bits scm_tc16_condvar;
|
||||
|
||||
struct scm_thread_wake_data;
|
||||
struct gc_mutator;
|
||||
|
||||
|
|
@ -144,10 +140,6 @@ scm_thread_handle (struct scm_thread *thread)
|
|||
|
||||
#define SCM_VALIDATE_THREAD(pos, a) \
|
||||
SCM_ASSERT_TYPE (SCM_I_IS_THREAD (a), (a), (pos), FUNC_NAME, "thread")
|
||||
#define SCM_VALIDATE_MUTEX(pos, a) \
|
||||
scm_assert_smob_type (scm_tc16_mutex, (a))
|
||||
#define SCM_VALIDATE_CONDVAR(pos, a) \
|
||||
scm_assert_smob_type (scm_tc16_condvar, (a))
|
||||
|
||||
SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data,
|
||||
scm_t_catch_handler handler, void *handler_data);
|
||||
|
|
@ -161,6 +153,9 @@ SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
|
|||
SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_block_asyncs (scm_i_pthread_mutex_t *mutex);
|
||||
|
||||
SCM_INTERNAL int scm_i_print_thread (SCM t, SCM port, scm_print_state *pstate);
|
||||
SCM_INTERNAL int scm_i_print_mutex (SCM m, SCM port, scm_print_state *pstate);
|
||||
SCM_INTERNAL int scm_i_print_condition_variable (SCM cv, SCM port,
|
||||
scm_print_state *pstate);
|
||||
|
||||
SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
|
||||
SCM_API SCM scm_yield (void);
|
||||
|
|
|
|||
|
|
@ -71,6 +71,7 @@
|
|||
<fluid> <dynamic-state> <frame> <vm> <vm-continuation>
|
||||
<keyword> <syntax> <atomic-box> <thread> <bitvector>
|
||||
<finalizer> <ephemeron> <ephemeron-table> <character-set>
|
||||
<mutex> <condition-variable>
|
||||
|
||||
;; Numbers.
|
||||
<number> <complex> <real> <integer> <fraction>
|
||||
|
|
@ -82,7 +83,7 @@
|
|||
;; corresponding classes, which may be obtained via class-of,
|
||||
;; once you have an instance. Perhaps FIXME to provide a
|
||||
;; smob-type-name->class procedure.
|
||||
<promise> <mutex> <condition-variable>
|
||||
<promise>
|
||||
<regexp> <hook> <random-state>
|
||||
<directory> <array>
|
||||
<dynamic-object> <macro>
|
||||
|
|
@ -1083,6 +1084,8 @@ slots as we go."
|
|||
(define-standard-class <ephemeron> (<top>))
|
||||
(define-standard-class <ephemeron-table> (<top>))
|
||||
(define-standard-class <character-set> (<top>))
|
||||
(define-standard-class <condition-variable> (<top>))
|
||||
(define-standard-class <mutex> (<top>))
|
||||
(define-standard-class <thread> (<top>))
|
||||
(define-standard-class <number> (<top>))
|
||||
(define-standard-class <complex> (<number>))
|
||||
|
|
@ -3531,8 +3534,6 @@ var{initargs}."
|
|||
;;;
|
||||
|
||||
(define <promise> (find-subclass <top> '<promise>))
|
||||
(define <mutex> (find-subclass <top> '<mutex>))
|
||||
(define <condition-variable> (find-subclass <top> '<condition-variable>))
|
||||
(define <regexp> (find-subclass <top> '<regexp>))
|
||||
(define <hook> (find-subclass <top> '<hook>))
|
||||
(define <bitvector> (find-subclass <top> '<bitvector>))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue