-/* Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002 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
-#include "coop-threads.h"
+#include "libguile/_scm.h"
+#include "libguile/validate.h"
+#include "libguile/coop-threads.h"
+#include "libguile/root.h"
/* A counter of the current number of threads */
size_t scm_thread_count = 0;
/* This is included rather than compiled separately in order
to simplify the configuration mechanism. */
-#include "coop.c"
+#include "libguile/coop.c"
/* A count-down counter used to determine when to switch
contexts */
coop_m scm_critical_section_mutex;
-#ifdef __STDC__
-size_t
-scm_threads_free_thread (SCM t)
-#else
-size_t
-scm_threads_free_thread (t)
- SCM t;
-#endif
-{
- scm_must_free (SCM_THREAD_DATA (t));
- return sizeof (coop_t);
-}
+static SCM all_threads;
-#ifdef __STDC__
-size_t
-scm_threads_free_mutex (SCM m)
-#else
-size_t
-scm_threads_free_mutex (m)
- SCM m;
-#endif
-{
- scm_must_free (SCM_MUTEX_DATA (m));
- return sizeof (coop_m);
-}
-
-#ifdef __STDC__
-size_t
-scm_threads_free_condvar (SCM c)
-#else
-size_t
-scm_threads_free_condvar (c)
- SCM c;
-#endif
-{
- scm_must_free (SCM_CONDVAR_DATA (c));
- return sizeof (coop_c);
-}
-
-#ifdef __STDC__
void
scm_threads_init (SCM_STACKITEM *i)
-#else
-void
-scm_threads_init (i)
- SCM_STACKITEM *i;
-#endif
{
coop_init();
+ scm_tc16_thread = scm_make_smob_type ("thread", 0);
+ scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (coop_m));
+ scm_tc16_condvar = scm_make_smob_type ("condition-variable",
+ sizeof (coop_c));
+
scm_thread_count = 1;
+#ifndef GUILE_PTHREAD_COMPAT
coop_global_main.sto = i;
+#endif
coop_global_main.base = i;
coop_global_curr = &coop_global_main;
coop_all_qput (&coop_global_allq, coop_global_curr);
coop_mutex_init (&scm_critical_section_mutex);
coop_global_main.data = 0; /* Initialized in init.c */
+
+ coop_global_main.handle = scm_cell (scm_tc16_thread,
+ (scm_t_bits) &coop_global_main);
+
+ scm_gc_register_root (&all_threads);
+ all_threads = scm_cons (coop_global_main.handle, SCM_EOL);
}
-#ifdef __STDC__
void
-scm_threads_mark_stacks ()
-#else
-void
-scm_threads_mark_stacks ()
-#endif
+scm_threads_mark_stacks (void)
{
coop_t *thread;
/* Active thread */
/* stack_len is long rather than sizet in order to guarantee
that &stack_len is long aligned */
-#ifdef STACK_GROWS_UP
+#if SCM_STACK_GROWS_UP
long stack_len = ((SCM_STACKITEM *) (&thread) -
(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 values from SCM_LENGTH and SCM_CHARS must remain
- * usable. This requirement is stricter than a liveness
+ * 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.
*/
/* 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,
- ((scm_sizet) sizeof scm_save_regs_gc_mark
+ ((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
scm_mark_locations (((size_t) 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 values from SCM_LENGTH and SCM_CHARS must remain
- * usable. This requirement is stricter than a liveness
+ * 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.
*/
/* 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,
- ((scm_sizet) sizeof scm_save_regs_gc_mark
+ ((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
scm_mark_locations ((SCM_STACKITEM *) &thread,
else
{
/* Suspended thread */
-#ifdef STACK_GROWS_UP
+#if SCM_STACK_GROWS_UP
long stack_len = ((SCM_STACKITEM *) (thread->sp) -
(SCM_STACKITEM *) thread->base);
SCM handler;
} scheme_launch_data;
-extern SCM scm_apply (SCM, SCM, SCM);
-
static SCM
scheme_body_bootstrip (scheme_launch_data* data)
{
/* First save the new root continuation */
data->rootcont = scm_root->rootcont;
- return scm_apply (data->body, SCM_EOL, SCM_EOL);
+ return scm_call_0 (data->body);
}
static SCM
scheme_handler_bootstrip (scheme_launch_data* data, SCM tag, SCM throw_args)
{
scm_root->rootcont = data->rootcont;
- return scm_apply (data->handler, scm_cons (tag, throw_args), SCM_EOL);
+ return scm_apply_1 (data->handler, tag, throw_args);
}
static void
data.rootcont = SCM_BOOL_F;
data.body = SCM_CADR (argl);
data.handler = SCM_CADDR (argl);
- scm_internal_cwdr ((scm_catch_body_t) scheme_body_bootstrip,
+ scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip,
&data,
- (scm_catch_handler_t) scheme_handler_bootstrip,
+ (scm_t_catch_handler) scheme_handler_bootstrip,
&data,
- &thread);
+ (SCM_STACKITEM *) &thread);
+ SCM_SET_CELL_WORD_1 (thread, 0);
scm_thread_count--;
+ all_threads = scm_delq (thread, all_threads);
SCM_DEFER_INTS;
}
-#ifdef __STDC__
+
SCM
scm_call_with_new_thread (SCM argl)
-#else
-SCM
-scm_call_with_new_thread (argl)
- SCM argl;
-#endif
+#define FUNC_NAME s_call_with_new_thread
{
SCM thread;
{
register SCM args = argl;
SCM thunk, handler;
- SCM_ASSERT (SCM_NIMP (args),
- scm_makfrom0str (s_call_with_new_thread),
- SCM_WNA, NULL);
+ if (!SCM_CONSP (args))
+ SCM_WRONG_NUM_ARGS ();
thunk = SCM_CAR (args);
SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
thunk,
SCM_ARG1,
s_call_with_new_thread);
args = SCM_CDR (args);
- SCM_ASSERT (SCM_NIMP (args),
- scm_makfrom0str (s_call_with_new_thread),
- SCM_WNA, NULL);
+ if (!SCM_CONSP (args))
+ SCM_WRONG_NUM_ARGS ();
handler = SCM_CAR (args);
SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (handler)),
handler,
SCM_ARG2,
s_call_with_new_thread);
- SCM_ASSERT (SCM_NULLP (SCM_CDR (args)),
- scm_makfrom0str (s_call_with_new_thread),
- SCM_WNA, NULL);
+ if (!SCM_NULLP (SCM_CDR (args)))
+ SCM_WRONG_NUM_ARGS ();
}
/* Make new thread. */
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
/* Make thread. */
- SCM_NEWCELL (thread);
+ thread = scm_cell (scm_tc16_thread, 0);
SCM_DEFER_INTS;
- SCM_SETCAR (thread, scm_tc16_thread);
argl = scm_cons (thread, argl);
/* Note that we couldn't pass a pointer to argl as data since the
argl variable may not exist in memory when the thread starts. */
t = coop_create (scheme_launch_thread, (void *) argl);
t->data = SCM_ROOT_STATE (root);
- SCM_SETCDR (thread, t);
+ t->handle = thread;
+ SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t);
scm_thread_count++;
+ all_threads = scm_cons (thread, all_threads);
/* Note that the following statement also could cause coop_yield.*/
SCM_ALLOW_INTS;
return thread;
}
+#undef FUNC_NAME
+
/* This is the second thread spawning mechanism: threads from C */
SCM thread;
SCM rootcont;
} u;
- scm_catch_body_t body;
+ scm_t_catch_body body;
void *body_data;
- scm_catch_handler_t handler;
+ scm_t_catch_handler handler;
void *handler_data;
} c_launch_data;
/* We must use the address of `thread', otherwise the compiler will
optimize it away. This is OK since the longest SCM_STACKITEM
also is a long. */
- scm_internal_cwdr ((scm_catch_body_t) c_body_bootstrip,
+ scm_internal_cwdr ((scm_t_catch_body) c_body_bootstrip,
data,
- (scm_catch_handler_t) c_handler_bootstrip,
+ (scm_t_catch_handler) c_handler_bootstrip,
data,
- &thread);
+ (SCM_STACKITEM *) &thread);
scm_thread_count--;
- scm_must_free ((char *) data);
+ free ((char *) data);
}
SCM
-scm_spawn_thread (scm_catch_body_t body, void *body_data,
- scm_catch_handler_t handler, void *handler_data)
+scm_spawn_thread (scm_t_catch_body body, void *body_data,
+ scm_t_catch_handler handler, void *handler_data)
{
SCM thread;
coop_t *t;
SCM root, old_winds;
- c_launch_data *data = (c_launch_data *) scm_must_malloc (sizeof (*data),
- "scm_spawn_thread");
+ c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data));
/* Unwind wind chain. */
old_winds = scm_dynwinds;
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
/* Make thread. */
- SCM_NEWCELL (thread);
+ thread = scm_cell (scm_tc16_thread, 0);
SCM_DEFER_INTS;
- SCM_SETCAR (thread, scm_tc16_thread);
data->u.thread = thread;
data->body = body;
data->handler_data = handler_data;
t = coop_create (c_launch_thread, (void *) data);
-
t->data = SCM_ROOT_STATE (root);
- SCM_SETCDR (thread, t);
+ t->handle = thread;
+ SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t);
scm_thread_count++;
+ all_threads = scm_cons (thread, all_threads);
/* Note that the following statement also could cause coop_yield.*/
SCM_ALLOW_INTS;
return thread;
}
-#ifdef __STDC__
SCM
-scm_join_thread (SCM t)
-#else
+scm_current_thread (void)
+{
+ return coop_global_curr->handle;
+}
+
SCM
-scm_join_thread (t)
- SCM t;
-#endif
+scm_all_threads (void)
{
- SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_join_thread);
- coop_join (SCM_THREAD_DATA (t));
- return SCM_BOOL_T;
+ return all_threads;
+}
+
+scm_root_state *
+scm_i_thread_root (SCM thread)
+{
+ return (scm_root_state *)((coop_t *)SCM_THREAD_DATA (thread))->data;
}
-#ifdef __STDC__
SCM
-scm_yield ()
-#else
+scm_join_thread (SCM thread)
+#define FUNC_NAME s_join_thread
+{
+ coop_t *thread_data;
+ SCM_VALIDATE_THREAD (1, thread);
+ /* Dirk:FIXME:: SCM_THREAD_DATA is a handle for a thread. It may be that a
+ * certain thread implementation uses a value of 0 as a valid thread handle.
+ * With the following code, this thread would always be considered finished.
+ */
+ /* Dirk:FIXME:: With preemptive threading, a thread may finish immediately
+ * after SCM_THREAD_DATA is read. Thus, it must be guaranteed that the
+ * handle remains valid until the thread-object is garbage collected, or
+ * a mutex has to be used for reading and modifying SCM_THREAD_DATA.
+ */
+ thread_data = SCM_THREAD_DATA (thread);
+ if (thread_data)
+ /* The thread is still alive */
+ coop_join (thread_data);
+ /* XXX - return real result. */
+ return SCM_BOOL_T;
+}
+#undef FUNC_NAME
+
+int
+scm_c_thread_exited_p (SCM thread)
+#define FUNC_NAME s_scm_thread_exited_p
+{
+ SCM_VALIDATE_THREAD (1, thread);
+ return SCM_THREAD_DATA (thread) != NULL;
+}
+#undef FUNC_NAME
+
SCM
-scm_yield ()
-#endif
+scm_yield (void)
{
/* Yield early */
scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
return SCM_BOOL_T;
}
-#ifdef __STDC__
SCM
-scm_single_thread_p ()
-#else
-SCM
-scm_single_thread_p ()
-#endif
+scm_single_thread_p (void)
{
return (coop_global_runq.tail == &coop_global_runq.t
? SCM_BOOL_T
: SCM_BOOL_F);
}
-#ifdef __STDC__
SCM
-scm_make_mutex ()
-#else
-SCM
-scm_make_mutex ()
-#endif
+scm_make_mutex (void)
{
- SCM m;
- coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex");
- SCM_NEWCELL (m);
- SCM_DEFER_INTS;
- SCM_SETCAR (m, scm_tc16_mutex);
- SCM_SETCDR (m, data);
- SCM_ALLOW_INTS;
- coop_mutex_init (data);
+ SCM m = scm_make_smob (scm_tc16_mutex);
+ coop_mutex_init (SCM_MUTEX_DATA (m));
return m;
}
-#ifdef __STDC__
SCM
scm_lock_mutex (SCM m)
-#else
-SCM
-scm_lock_mutex (m)
- SCM m;
-#endif
{
- SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
+ SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
coop_mutex_lock (SCM_MUTEX_DATA (m));
return SCM_BOOL_T;
}
-#ifdef __STDC__
SCM
-scm_unlock_mutex (SCM m)
-#else
+scm_try_mutex (SCM m)
+{
+ SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_lock_mutex);
+ return SCM_BOOL (coop_mutex_trylock (SCM_MUTEX_DATA (m)));
+}
+
SCM
-scm_unlock_mutex (m)
- SCM m;
-#endif
+scm_unlock_mutex (SCM m)
{
- SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
+ SCM_ASSERT (SCM_MUTEXP (m), m, SCM_ARG1, s_unlock_mutex);
coop_mutex_unlock(SCM_MUTEX_DATA (m));
/* Yield early */
return SCM_BOOL_T;
}
-#ifdef __STDC__
-SCM
-scm_make_condition_variable ()
-#else
SCM
-scm_make_condition_variable ()
-#endif
+scm_make_condition_variable (void)
{
- SCM c;
- coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar");
- SCM_NEWCELL (c);
- SCM_DEFER_INTS;
- SCM_SETCAR (c, scm_tc16_condvar);
- SCM_SETCDR (c, data);
- SCM_ALLOW_INTS;
+ SCM c = scm_make_smob (scm_tc16_condvar);
coop_condition_variable_init (SCM_CONDVAR_DATA (c));
return c;
}
-#ifdef __STDC__
SCM
-scm_wait_condition_variable (SCM c, SCM m)
-#else
-SCM
-scm_wait_condition_variable (c, m)
- SCM c;
- SCM m;
-#endif
+scm_timed_wait_condition_variable (SCM c, SCM m, SCM t)
+#define FUNC_NAME s_wait_condition_variable
{
- SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c),
+ coop_c *cv;
+ coop_m *mx;
+ scm_t_timespec waittime;
+
+ SCM_ASSERT (SCM_CONDVARP (c),
c,
SCM_ARG1,
s_wait_condition_variable);
- SCM_ASSERT (SCM_NIMP (m) && SCM_MUTEXP (m),
+ SCM_ASSERT (SCM_MUTEXP (m),
m,
SCM_ARG2,
s_wait_condition_variable);
- coop_condition_variable_wait_mutex (SCM_CONDVAR_DATA (c),
- SCM_MUTEX_DATA (m));
- return SCM_BOOL_T;
+
+ cv = SCM_CONDVAR_DATA (c);
+ mx = SCM_MUTEX_DATA (m);
+
+ if (!SCM_UNBNDP (t))
+ {
+ if (SCM_CONSP (t))
+ {
+ SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
+ SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec);
+ waittime.tv_nsec *= 1000;
+ }
+ else
+ {
+ SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
+ waittime.tv_nsec = 0;
+ }
+ return SCM_BOOL(
+ coop_condition_variable_timed_wait_mutex (cv, mx, &waittime));
+ }
+ else
+ {
+ coop_condition_variable_wait_mutex (cv, mx);
+ return SCM_BOOL_T;
+ }
}
+#undef FUNC_NAME
-#ifdef __STDC__
SCM
scm_signal_condition_variable (SCM c)
-#else
-SCM
-scm_signal_condition_variable (c)
- SCM c;
-#endif
{
- SCM_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c),
+ SCM_ASSERT (SCM_CONDVARP (c),
c,
SCM_ARG1,
s_signal_condition_variable);
coop_condition_variable_signal (SCM_CONDVAR_DATA (c));
return SCM_BOOL_T;
}
+
+SCM
+scm_broadcast_condition_variable (SCM c)
+{
+ SCM_ASSERT (SCM_CONDVARP (c),
+ c,
+ SCM_ARG1,
+ s_broadcast_condition_variable);
+ coop_condition_variable_broadcast (SCM_CONDVAR_DATA (c));
+ return SCM_BOOL_T;
+}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff