-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003 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.
+ * 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.
*
- * 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 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"
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;
}
#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_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} "
}
#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
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);
"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);
{
scm_t_cond *c = SCM_CONDVAR_DATA (cv);
scm_t_mutex *m = SCM_MUTEX_DATA (mx);
- err = scm_cond_wait (c, m);
+ 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;
}
/* 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);
+#if SCM_STACK_GROWS_UP
+ stack_len = SCM_STACK_PTR (&t) - t->base;
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
scm_mark_locations (((size_t) t->base,
(sizet) stack_len));
#else
- stack_len = ((SCM_STACKITEM *) t->base -
- (SCM_STACKITEM *) (&t));
+ stack_len = t->base - SCM_STACK_PTR (&t);
/* Protect from the C stack. This must be the first marking
* done because it provides information about what objects
((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
- scm_mark_locations ((SCM_STACKITEM *) &t,
- stack_len);
+ scm_mark_locations (SCM_STACK_PTR (&t), stack_len);
#endif
}
else
{
/* Suspended thread */
-#ifdef STACK_GROWS_UP
+#if SCM_STACK_GROWS_UP
long stack_len = t->top - t->base;
scm_mark_locations (t->base, stack_len);
#else
}
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 ()
{
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++)
{
SCM 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))
if (SCM_CAR (threads) != cur_thread)
if (threads_initialized_p && !--gc_section_count)
{
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))
}
scm_i_plugin_mutex_unlock (&thread_admin_mutex);
}
- 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;
-#ifdef USE_PTHREAD_THREADS
+#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;
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"
}
HCoop / bpt / guile.git / blobdiff