summaryrefslogtreecommitdiff
path: root/libguile/threads.c
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2002-12-15 14:24:34 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2002-12-15 14:24:34 +0000
commit28d52ebb1945223db0df88cc33e4a88d860dafbb (patch)
tree41e93008606708a69c3d3f0a7065abca21a477ad /libguile/threads.c
parent2ff4f1815955aa0c6b759d3c160658fe576ba5ee (diff)
downloadguile-28d52ebb1945223db0df88cc33e4a88d860dafbb.tar.gz
* __scm.h (SCM_DEFER_INTS, SCM_ALLOW_INTS): New definitions.
Simply lock a thread C API recursive mutex. (SCM_NONREC_CRITICAL_SECTION_START, SCM_NONREC_CRITICAL_SECTION_END, SCM_REC_CRITICAL_SECTION_START, SCM_REC_CRITICAL_SECTION_END): Removed. * eval.c: Replaced SOURCE_SECTION_START / SOURCE_SECTION_END with direct calls to scm_rec_mutex_lock / unlock around the three calls to scm_m_expand_body. * eval.c, eval.h (promise_free): New function. (scm_force): Rewritten; Now thread-safe; Removed SCM_DEFER/ALLOW_INTS. * pthread-threads.h: Added partially implemented plugin interface for recursive mutexes. These are, for now, only intended to be used internally within the Guile implementation. * pthread-threads.c: New file. * threads.c: Conditionally #include "pthread-threads.c". * eval.c, eval.h (scm_makprom, scm_force): Rewritten to be thread-safe; * snarf.h (SCM_MUTEX, SCM_GLOBAL_MUTEX, SCM_REC_MUTEX, SCM_GLOBAL_REC_MUTEX): New macros. * eval.c, threads.c, threads.h, snarf.h: Rewrote critical section macros---use mutexes instead. * tags.h (SCM_IM_FUTURE): New tag. * eval.c (scm_m_future): New primitive macro. (SCM_CEVAL): Support futures. (unmemocopy): Support unmemoization of futures. * print.c (scm_isymnames): Name of future isym.
Diffstat (limited to 'libguile/threads.c')
-rw-r--r--libguile/threads.c123
1 files changed, 106 insertions, 17 deletions
diff --git a/libguile/threads.c b/libguile/threads.c
index 33f092768..1fdf77f5e 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -490,6 +490,63 @@ SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
}
#undef FUNC_NAME
+SCM *scm_loc_sys_thread_handler;
+
+SCM
+scm_i_make_future (SCM thunk)
+{
+ SCM_RETURN_NEWSMOB2 (scm_tc16_future,
+ create_thread ((scm_t_catch_body) scm_call_0,
+ thunk,
+ (scm_t_catch_handler) scm_apply_1,
+ *scm_loc_sys_thread_handler,
+ scm_cons (thunk,
+ *scm_loc_sys_thread_handler)),
+ scm_make_rec_mutex ());
+}
+
+static size_t
+future_free (SCM future)
+{
+ scm_rec_mutex_free (SCM_FUTURE_MUTEX (future));
+ return 0;
+}
+
+static int
+future_print (SCM exp, SCM port, scm_print_state *pstate)
+{
+ int writingp = SCM_WRITINGP (pstate);
+ scm_puts ("#<future ", port);
+ SCM_SET_WRITINGP (pstate, 1);
+ scm_iprin1 (SCM_FUTURE_DATA (exp), port, pstate);
+ SCM_SET_WRITINGP (pstate, writingp);
+ scm_putc ('>', port);
+ return !0;
+}
+
+SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0,
+ (SCM future),
+ "If the future @var{x} has not been computed yet, compute and\n"
+ "return @var{x}, otherwise just return the previously computed\n"
+ "value.")
+#define FUNC_NAME s_scm_future_ref
+{
+ SCM_VALIDATE_FUTURE (1, future);
+ scm_rec_mutex_lock (SCM_FUTURE_MUTEX (future));
+ if (!SCM_FUTURE_COMPUTED_P (future))
+ {
+ SCM value = scm_join_thread (SCM_FUTURE_DATA (future));
+ if (!SCM_FUTURE_COMPUTED_P (future))
+ {
+ SCM_SET_FUTURE_DATA (future, value);
+ SCM_SET_FUTURE_COMPUTED (future);
+ }
+ }
+ scm_rec_mutex_unlock (SCM_FUTURE_MUTEX (future));
+ return SCM_FUTURE_DATA (future);
+}
+#undef FUNC_NAME
+
/*** Fair mutexes */
/* We implement our own mutex type since we want them to be 'fair', we
@@ -1068,6 +1125,30 @@ scm_mutex_lock (scm_t_mutex *m)
return res;
}
+scm_t_rec_mutex *
+scm_make_rec_mutex ()
+{
+ scm_t_rec_mutex *m = scm_malloc (sizeof (scm_t_rec_mutex));
+ scm_i_plugin_rec_mutex_init (m, &scm_i_plugin_rec_mutex);
+ return m;
+}
+
+void
+scm_rec_mutex_free (scm_t_rec_mutex *m)
+{
+ scm_i_plugin_rec_mutex_destroy (m);
+ free (m);
+}
+
+int
+scm_rec_mutex_lock (scm_t_rec_mutex *m)
+{
+ scm_thread *t = scm_i_leave_guile ();
+ int res = scm_i_plugin_rec_mutex_lock (m);
+ scm_i_enter_guile (t);
+ return res;
+}
+
int
scm_cond_wait (scm_t_cond *c, scm_t_mutex *m)
{
@@ -1166,16 +1247,15 @@ scm_c_thread_exited_p (SCM thread)
static scm_t_cond wake_up_cond;
int scm_i_thread_go_to_sleep;
-static scm_t_mutex gc_section_mutex;
-static scm_thread *gc_section_owner;
+static scm_t_rec_mutex gc_section_mutex;
static int gc_section_count = 0;
static int threads_initialized_p = 0;
void
scm_i_thread_put_to_sleep ()
{
- SCM_REC_CRITICAL_SECTION_START (gc_section);
- if (threads_initialized_p && gc_section_count == 1)
+ scm_rec_mutex_lock (&gc_section_mutex);
+ if (threads_initialized_p && !gc_section_count++)
{
SCM threads;
scm_i_plugin_mutex_lock (&thread_admin_mutex);
@@ -1209,7 +1289,7 @@ scm_i_thread_invalidate_freelists ()
void
scm_i_thread_wake_up ()
{
- if (threads_initialized_p && gc_section_count == 1)
+ if (threads_initialized_p && !--gc_section_count)
{
SCM threads;
/* Need to lock since woken threads can die and be deleted from list */
@@ -1224,7 +1304,7 @@ scm_i_thread_wake_up ()
}
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
}
- SCM_REC_CRITICAL_SECTION_END (gc_section);
+ scm_rec_mutex_unlock (&gc_section_mutex);
}
void
@@ -1236,13 +1316,12 @@ scm_i_thread_sleep_for_gc ()
resume (t);
}
-/* The mother of all recursive critical sections */
-scm_t_mutex scm_i_section_mutex;
-
scm_t_mutex scm_i_critical_section_mutex;
-scm_t_mutex scm_i_defer_mutex;
-int scm_i_defer_count = 0;
-scm_thread *scm_i_defer_owner = 0;
+scm_t_rec_mutex scm_i_defer_mutex;
+
+#ifdef USE_PTHREAD_THREADS
+#include "libguile/pthread-threads.c"
+#endif
/*** Initialization */
@@ -1250,23 +1329,26 @@ void
scm_threads_prehistory ()
{
scm_thread *t;
- scm_i_plugin_mutex_init (&thread_admin_mutex, 0);
- scm_i_plugin_mutex_init (&gc_section_mutex, 0);
+ scm_i_plugin_mutex_init (&thread_admin_mutex, &scm_i_plugin_mutex);
+ scm_i_plugin_rec_mutex_init (&gc_section_mutex, &scm_i_plugin_rec_mutex);
scm_i_plugin_cond_init (&wake_up_cond, 0);
- scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, 0);
+ scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, &scm_i_plugin_mutex);
thread_count = 1;
scm_i_plugin_key_create (&scm_i_thread_key, 0);
scm_i_plugin_key_create (&scm_i_root_state_key, 0);
- scm_i_plugin_mutex_init (&scm_i_defer_mutex, 0);
- scm_i_plugin_mutex_init (&scm_i_section_mutex, 0);
+ scm_i_plugin_rec_mutex_init (&scm_i_defer_mutex, &scm_i_plugin_rec_mutex);
/* Allocate a fake thread object to be used during bootup. */
t = malloc (sizeof (scm_thread));
t->base = NULL;
t->clear_freelists_p = 0;
scm_setspecific (scm_i_thread_key, t);
+#ifdef USE_PTHREAD_THREADS
+ scm_init_pthread_threads ();
+#endif
}
scm_t_bits scm_tc16_thread;
+scm_t_bits scm_tc16_future;
scm_t_bits scm_tc16_mutex;
scm_t_bits scm_tc16_fair_mutex;
scm_t_bits scm_tc16_condvar;
@@ -1305,12 +1387,19 @@ scm_init_threads (SCM_STACKITEM *base)
scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark);
+ scm_tc16_future = scm_make_smob_type ("future", 0);
+ scm_set_smob_mark (scm_tc16_future, scm_markcdr);
+ scm_set_smob_free (scm_tc16_future, future_free);
+ scm_set_smob_print (scm_tc16_future, future_print);
+
threads_initialized_p = 1;
}
void
scm_init_thread_procs ()
{
+ scm_loc_sys_thread_handler
+ = SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F));
#include "libguile/threads.x"
}