-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
*
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
*
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
\f
C level threads.
*/
+#include "libguile/_scm.h"
+
+#if HAVE_UNISTD_H
#include <unistd.h>
+#endif
#include <stdio.h>
#include <assert.h>
+#if HAVE_SYS_TIME_H
#include <sys/time.h>
+#endif
-#include "libguile/_scm.h"
#include "libguile/validate.h"
#include "libguile/root.h"
#include "libguile/eval.h"
enqueue (SCM q, SCM t)
{
SCM c = scm_cons (t, SCM_EOL);
- if (SCM_NULLP (SCM_CDR (q)))
+ if (scm_is_null (SCM_CDR (q)))
SCM_SETCDR (q, c);
else
SCM_SETCDR (SCM_CAR (q), c);
remqueue (SCM q, SCM c)
{
SCM p, prev = q;
- for (p = SCM_CDR (q); !SCM_NULLP (p); p = SCM_CDR (p))
+ for (p = SCM_CDR (q); !scm_is_null (p); p = SCM_CDR (p))
{
- if (SCM_EQ_P (p, c))
+ if (scm_is_eq (p, c))
{
- if (SCM_EQ_P (c, SCM_CAR (q)))
+ if (scm_is_eq (c, SCM_CAR (q)))
SCM_SETCAR (q, SCM_CDR (c));
SCM_SETCDR (prev, SCM_CDR (c));
return;
dequeue (SCM q)
{
SCM c = SCM_CDR (q);
- if (SCM_NULLP (c))
+ if (scm_is_null (c))
return SCM_BOOL_F;
else
{
SCM_SETCDR (q, SCM_CDR (c));
- if (SCM_NULLP (SCM_CDR (q)))
+ if (scm_is_null (SCM_CDR (q)))
SCM_SETCAR (q, SCM_EOL);
return SCM_CAR (c);
}
SCM result;
int exited;
- SCM joining_threads;
-
/* For keeping track of the stack and registers. */
SCM_STACKITEM *base;
SCM_STACKITEM *top;
t->handle = z;
t->result = creation_protects;
t->base = NULL;
- t->joining_threads = make_queue ();
scm_i_plugin_cond_init (&t->sleep_cond, 0);
- scm_i_plugin_mutex_init (&t->heap_mutex, 0);
+ scm_i_plugin_mutex_init (&t->heap_mutex, &scm_i_plugin_mutex);
t->clear_freelists_p = 0;
t->exited = 0;
return z;
{
scm_thread *t = SCM_THREAD_DATA (obj);
scm_gc_mark (t->result);
- scm_gc_mark (t->joining_threads);
return t->root->handle; /* mark root-state of this thread */
}
{
scm_thread *t = SCM_THREAD_DATA (exp);
scm_puts ("#<thread ", port);
- scm_intprint ((unsigned long)t, 16, port);
- scm_putc ('>', port);
+ scm_uintprint ((size_t)t->thread, 10, port);
+ scm_puts (" (", port);
+ scm_uintprint ((scm_t_bits)t, 16, port);
+ scm_puts (")>", port);
return 1;
}
scm_thread *c = SCM_CURRENT_THREAD;
/* record top of stack for the GC */
- c->top = (SCM_STACKITEM *)&c;
+ c->top = SCM_STACK_PTR (&c);
/* save registers. */
SCM_FLUSH_REGISTER_WINDOWS;
setjmp (c->regs);
reached. Return 0 when it has been unblocked; errno otherwise.
*/
static int
-timed_block (const struct timespec *at)
+timed_block (const scm_t_timespec *at)
{
int err;
scm_thread *t = suspend ();
all_threads = scm_delq_x (thread, all_threads);
t->exited = 1;
thread_count--;
- scm_i_plugin_mutex_unlock (&thread_admin_mutex);
-
+ /* detach before unlocking in order to not become joined when detached */
scm_thread_detach (t->thread);
+ scm_i_plugin_mutex_unlock (&thread_admin_mutex);
}
static void *
launch_thread (void *p)
{
- really_launch ((SCM_STACKITEM *)&p, (launch_data *)p);
+ really_launch (SCM_STACK_PTR (&p), (launch_data *) p);
return 0;
}
{
scm_t_thread th;
- SCM root, old_winds;
+ SCM root;
launch_data *data;
scm_thread *t;
int err;
- /* Unwind wind chain. */
- old_winds = scm_dynwinds;
- scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds));
-
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
data = scm_malloc (sizeof (launch_data));
/* must initialize root state pointer before the thread is linked
into all_threads */
t->root = SCM_ROOT_STATE (root);
+ /* disconnect from parent, to prevent remembering dead threads */
+ t->root->parent = SCM_BOOL_F;
+ /* start with an empty dynwind chain */
+ t->root->dynwinds = SCM_EOL;
/* In order to avoid the need of synchronization between parent
and child thread, we need to insert the child into all_threads
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
}
- /* Return to old dynamic context. */
- scm_dowinds (old_winds, - scm_ilength (old_winds));
-
if (err)
{
errno = err;
SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 2, 0, 0,
(SCM thunk, SCM handler),
-"Evaluate @var{(thunk)} in a new thread, and new dynamic context, "
+"Evaluate @code{(@var{thunk})} in a new thread, and new dynamic context, "
"returning a new thread object representing the thread. "
"If an error occurs during evaluation, call error-thunk, passing it an "
"error code describing the condition. "
"All the evaluation rules for dynamic roots apply to threads.")
#define FUNC_NAME s_scm_call_with_new_thread
{
- SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)), thunk, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)), handler, SCM_ARG2,
+ SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, SCM_ARG1, FUNC_NAME);
+ SCM_ASSERT (scm_is_true (scm_procedure_p (handler)), handler, SCM_ARG2,
FUNC_NAME);
return create_thread ((scm_t_catch_body) scm_call_0, thunk,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
+ (),
+"Move the calling thread to the end of the scheduling queue.")
+#define FUNC_NAME s_scm_yield
+{
+ return scm_from_bool (scm_thread_yield ());
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_join_thread, "join-thread", 1, 0, 0,
(SCM thread),
"Suspend execution of the calling thread until the target @var{thread} "
SCM res;
SCM_VALIDATE_THREAD (1, thread);
- if (SCM_EQ_P (cur_thread, thread))
+ if (scm_is_eq (cur_thread, thread))
SCM_MISC_ERROR ("can not join the current thread", SCM_EOL);
t = SCM_THREAD_DATA (thread);
if (!t->exited)
{
- scm_thread *c = scm_i_leave_guile ();
+ scm_thread *c;
+ c = scm_i_leave_guile ();
while (!THREAD_INITIALIZED_P (t))
- SCM_TICK;
+ scm_i_plugin_thread_yield ();
scm_thread_join (t->thread, 0);
scm_i_enter_guile (c);
}
}
#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
{
SCM mx = scm_make_smob (scm_tc16_fair_mutex);
fair_mutex *m = SCM_MUTEX_DATA (mx);
- scm_i_plugin_mutex_init (&m->lock, 0);
+ scm_i_plugin_mutex_init (&m->lock, &scm_i_plugin_mutex);
m->lockedp = 0;
m->owner = SCM_BOOL_F;
m->level = 0;
else
{
SCM next = dequeue (m->waiting);
- if (!SCM_FALSEP (next))
+ if (scm_is_true (next))
{
m->owner = next;
unblock (SCM_THREAD_DATA (next));
static int
fair_cond_timedwait (fair_cond *c,
fair_mutex *m,
- const struct timespec *waittime)
+ const scm_t_timespec *waittime)
{
int err;
scm_i_plugin_mutex_lock (&c->lock);
{
SCM th;
scm_i_plugin_mutex_lock (&c->lock);
- if (!SCM_FALSEP (th = dequeue (c->waiting)))
+ if (scm_is_true (th = dequeue (c->waiting)))
unblock (SCM_THREAD_DATA (th));
scm_i_plugin_mutex_unlock (&c->lock);
return 0;
{
SCM th;
scm_i_plugin_mutex_lock (&c->lock);
- while (!SCM_FALSEP (th = dequeue (c->waiting)))
+ while (scm_is_true (th = dequeue (c->waiting)))
unblock (SCM_THREAD_DATA (th));
scm_i_plugin_mutex_unlock (&c->lock);
return 0;
#define FUNC_NAME s_scm_make_mutex
{
SCM mx = scm_make_smob (scm_tc16_mutex);
- scm_i_plugin_mutex_init (SCM_MUTEX_DATA (mx), 0);
+ scm_i_plugin_mutex_init (SCM_MUTEX_DATA (mx), &scm_i_plugin_mutex);
return mx;
}
#undef FUNC_NAME
else
{
scm_t_mutex *m = SCM_MUTEX_DATA (mx);
- scm_thread *t = scm_i_leave_guile ();
- err = scm_i_plugin_mutex_lock (m);
- scm_i_enter_guile (t);
+ err = scm_mutex_lock (m);
}
if (err)
else
{
scm_t_mutex *m = SCM_MUTEX_DATA (mx);
- scm_thread *t = scm_i_leave_guile ();
- err = scm_i_plugin_mutex_trylock (m);
- scm_i_enter_guile (t);
+ err = scm_mutex_trylock (m);
}
if (err == EBUSY)
else
{
scm_t_mutex *m = SCM_MUTEX_DATA (mx);
- err = scm_i_plugin_mutex_unlock (m);
+ err = scm_mutex_unlock (m);
}
if (err)
"is returned. ")
#define FUNC_NAME s_scm_timed_wait_condition_variable
{
- struct timespec waittime;
+ scm_t_timespec waittime;
int err;
SCM_VALIDATE_CONDVAR (1, cv);
if (!SCM_UNBNDP (t))
{
- if (SCM_CONSP (t))
+ if (scm_is_pair (t))
{
SCM_VALIDATE_UINT_COPY (3, SCM_CAR (t), waittime.tv_sec);
SCM_VALIDATE_UINT_COPY (3, SCM_CDR (t), waittime.tv_nsec);
{
scm_t_cond *c = SCM_CONDVAR_DATA (cv);
scm_t_mutex *m = SCM_MUTEX_DATA (mx);
- scm_thread *t = scm_i_leave_guile ();
- err = scm_i_plugin_cond_wait (c, m);
- scm_i_enter_guile (t);
+ if (SCM_UNBNDP (t))
+ err = scm_cond_wait (c, m);
+ else
+ err = scm_cond_timedwait (c, m, &waittime);
}
if (err)
{
+ if (err == ETIMEDOUT)
+ return SCM_BOOL_F;
errno = err;
SCM_SYSERROR;
}
else
{
scm_t_cond *c = SCM_CONDVAR_DATA (cv);
- scm_i_plugin_cond_signal (c);
+ scm_cond_signal (c);
}
return SCM_BOOL_T;
}
else
{
scm_t_cond *c = SCM_CONDVAR_DATA (cv);
- scm_i_plugin_cond_broadcast (c);
+ scm_cond_broadcast (c);
}
return SCM_BOOL_T;
}
scm_threads_mark_stacks (void)
{
volatile SCM c;
- for (c = all_threads; !SCM_NULLP (c); c = SCM_CDR (c))
+
+ for (c = all_threads; !scm_is_null (c); c = SCM_CDR (c))
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (c));
if (!THREAD_INITIALIZED_P (t))
/* Not fully initialized yet. */
continue;
}
+
if (t->top == NULL)
{
- long stack_len;
-#ifdef SCM_DEBUG
- if (t->thread != scm_thread_self ())
- abort ();
-#endif
- /* Active thread */
- /* stack_len is long rather than sizet in order to guarantee
- that &stack_len is long aligned */
-#ifdef STACK_GROWS_UP
- stack_len = ((SCM_STACKITEM *) (&t) -
- (SCM_STACKITEM *) thread->base);
-
- /* Protect from the C stack. This must be the first marking
- * done because it provides information about what objects
- * are "in-use" by the C code. "in-use" objects are those
- * for which the information about length and base address must
- * remain usable. This requirement is stricter than a liveness
- * requirement -- in particular, it constrains the implementation
- * of scm_resizuve.
- */
- SCM_FLUSH_REGISTER_WINDOWS;
- /* This assumes that all registers are saved into the jmp_buf */
- setjmp (scm_save_regs_gc_mark);
- scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
- ((size_t) sizeof scm_save_regs_gc_mark
- / sizeof (SCM_STACKITEM)));
-
- scm_mark_locations (((size_t) t->base,
- (sizet) stack_len));
-#else
- stack_len = ((SCM_STACKITEM *) t->base -
- (SCM_STACKITEM *) (&t));
-
- /* Protect from the C stack. This must be the first marking
- * done because it provides information about what objects
- * are "in-use" by the C code. "in-use" objects are those
- * for which the information about length and base address must
- * remain usable. This requirement is stricter than a liveness
- * requirement -- in particular, it constrains the implementation
- * of scm_resizuve.
+ /* Thread has not been suspended, which should never happen.
*/
- SCM_FLUSH_REGISTER_WINDOWS;
- /* This assumes that all registers are saved into the jmp_buf */
- setjmp (scm_save_regs_gc_mark);
- scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
- ((size_t) sizeof scm_save_regs_gc_mark
- / sizeof (SCM_STACKITEM)));
-
- scm_mark_locations ((SCM_STACKITEM *) &t,
- stack_len);
-#endif
+ abort ();
}
- else
- {
- /* Suspended thread */
-#ifdef STACK_GROWS_UP
- long stack_len = t->top - t->base;
- scm_mark_locations (t->base, stack_len);
+
+ {
+#if SCM_STACK_GROWS_UP
+ scm_mark_locations (t->base, t->top - t->base);
#else
- long stack_len = t->base - t->top;
- scm_mark_locations (t->top, stack_len);
+ scm_mark_locations (t->top, t->base - t->top);
#endif
- scm_mark_locations ((SCM_STACKITEM *) t->regs,
- ((size_t) sizeof(t->regs)
- / sizeof (SCM_STACKITEM)));
- }
+ }
+ scm_mark_locations ((SCM_STACKITEM *) t->regs,
+ ((size_t) sizeof(t->regs)
+ / sizeof (SCM_STACKITEM)));
}
+
+ SCM_MARK_BACKING_STORE ();
}
/*** Select */
return create_thread (body, body_data, handler, handler_data, SCM_BOOL_F);
}
+scm_t_thread
+scm_c_scm2thread (SCM thread)
+{
+ return SCM_THREAD_DATA (thread)->thread;
+}
+
int
scm_mutex_lock (scm_t_mutex *m)
{
}
int
-scm_cond_timedwait (scm_t_cond *c, scm_t_mutex *m, const struct timespec *wt)
+scm_cond_timedwait (scm_t_cond *c, scm_t_mutex *m, const scm_t_timespec *wt)
{
scm_thread *t = scm_i_leave_guile ();
int res = scm_i_plugin_cond_timedwait (c, m, wt);
return res;
}
+void *
+scm_getspecific (scm_t_key k)
+{
+ return scm_i_plugin_getspecific (k);
+}
+
+int
+scm_setspecific (scm_t_key k, void *s)
+{
+ return scm_i_plugin_setspecific (k, s);
+}
+
void
scm_enter_guile ()
{
"Return a list of all threads.")
#define FUNC_NAME s_scm_all_threads
{
- return all_threads;
+ return scm_list_copy (all_threads);
}
#undef FUNC_NAME
"Return @code{#t} iff @var{thread} has exited.\n")
#define FUNC_NAME s_scm_thread_exited_p
{
- return SCM_BOOL (scm_c_thread_exited_p (thread));
+ return scm_from_bool (scm_c_thread_exited_p (thread));
}
#undef FUNC_NAME
static scm_t_cond wake_up_cond;
int scm_i_thread_go_to_sleep;
-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_mutex_lock (&gc_section_mutex);
- if (threads_initialized_p && !gc_section_count++)
+ if (threads_initialized_p)
{
SCM threads;
+
+ /* We leave Guile completely before locking the
+ thread_admin_mutex. This ensures that other threads can put
+ us to sleep while we block on that mutex.
+ */
+ scm_i_leave_guile ();
scm_i_plugin_mutex_lock (&thread_admin_mutex);
threads = all_threads;
/* Signal all threads to go to sleep */
scm_i_thread_go_to_sleep = 1;
- for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
- if (SCM_CAR (threads) != cur_thread)
- {
- scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
- scm_i_plugin_mutex_lock (&t->heap_mutex);
- }
+ for (; !scm_is_null (threads); threads = SCM_CDR (threads))
+ {
+ scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
+ scm_i_plugin_mutex_lock (&t->heap_mutex);
+ }
scm_i_thread_go_to_sleep = 0;
- scm_i_plugin_mutex_unlock (&thread_admin_mutex);
}
}
void
scm_i_thread_invalidate_freelists ()
{
- /* Don't need to lock thread_admin_mutex here since we are sinle threaded */
+ /* Don't need to lock thread_admin_mutex here since we are single threaded */
SCM threads = all_threads;
- for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
+ for (; !scm_is_null (threads); threads = SCM_CDR (threads))
if (SCM_CAR (threads) != cur_thread)
{
scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
void
scm_i_thread_wake_up ()
{
- if (threads_initialized_p && !--gc_section_count)
+ if (threads_initialized_p)
{
SCM threads;
- /* Need to lock since woken threads can die and be deleted from list */
- scm_i_plugin_mutex_lock (&thread_admin_mutex);
threads = all_threads;
scm_i_plugin_cond_broadcast (&wake_up_cond);
- for (; !SCM_NULLP (threads); threads = SCM_CDR (threads))
- if (SCM_CAR (threads) != cur_thread)
- {
- scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
- scm_i_plugin_mutex_unlock (&t->heap_mutex);
- }
+ for (; !scm_is_null (threads); threads = SCM_CDR (threads))
+ {
+ scm_thread *t = SCM_THREAD_DATA (SCM_CAR (threads));
+ scm_i_plugin_mutex_unlock (&t->heap_mutex);
+ }
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
+ scm_i_enter_guile (SCM_CURRENT_THREAD);
}
- scm_rec_mutex_unlock (&gc_section_mutex);
}
void
scm_t_mutex scm_i_critical_section_mutex;
scm_t_rec_mutex scm_i_defer_mutex;
-#ifdef USE_PTHREAD_THREADS
-#include "libguile/pthread-threads.c"
+#if SCM_USE_PTHREAD_THREADS
+# include "libguile/pthread-threads.c"
#endif
+#include "libguile/threads-plugin.c"
/*** Initialization */
scm_threads_prehistory ()
{
scm_thread *t;
+#if SCM_USE_PTHREAD_THREADS
+ /* Must be called before any initialization of a mutex. */
+ scm_init_pthread_threads ();
+#endif
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, &scm_i_plugin_mutex);
thread_count = 1;
t = malloc (sizeof (scm_thread));
t->base = NULL;
t->clear_freelists_p = 0;
+ scm_i_plugin_mutex_init (&t->heap_mutex, &scm_i_plugin_mutex);
scm_setspecific (scm_i_thread_key, t);
-#ifdef USE_PTHREAD_THREADS
- scm_init_pthread_threads ();
-#endif
+ scm_i_enter_guile (t);
}
scm_t_bits scm_tc16_thread;
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;
}
+/* scm_i_misc_mutex is intended for miscellaneous uses, to protect
+ operations which are non-reentrant or non-thread-safe but which are
+ either not important enough or not used often enough to deserve their own
+ private mutex. */
+SCM_GLOBAL_MUTEX (scm_i_misc_mutex);
+
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"
}
HCoop / bpt / guile.git / blobdiff