-/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 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
*
* 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * 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.
*
* 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.
- */
+ * If you do not wish that, delete this exception notice. */
+
+
\f
-#include "coop-threads.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);
-}
-
-#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_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_global_main.data = 0; /* Initialized in init.c */
}
-#ifdef __STDC__
-void
-scm_threads_mark_stacks ()
-#else
void
-scm_threads_mark_stacks ()
-#endif
+scm_threads_mark_stacks (void)
{
coop_t *thread;
/* 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,
}
}
-#ifdef __STDC__
-void
-launch_thread (void *p)
-#else
-void
-launch_thread (p)
- void *p;
-#endif
+/* NOTE: There are TWO mechanisms for starting a thread: The first one
+ is used when spawning a thread from Scheme, while the second one is
+ used from C.
+
+ It might be argued that the first should be implemented in terms of
+ the second. The reason it isn't is that that would require an
+ extra unnecessary malloc (the thread_args structure). By providing
+ one pair of extra functions (c_launch_thread, scm_spawn_thread) the
+ Scheme threads are started more efficiently. */
+
+/* This is the first thread spawning mechanism: threads from Scheme */
+
+typedef struct scheme_launch_data {
+ SCM rootcont;
+ SCM body;
+ SCM handler;
+} scheme_launch_data;
+
+static SCM
+scheme_body_bootstrip (scheme_launch_data* data)
+{
+ /* First save the new root continuation */
+ data->rootcont = scm_root->rootcont;
+ 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_1 (data->handler, tag, throw_args);
+}
+
+static void
+scheme_launch_thread (void *p)
{
/* The thread object will be GC protected by being a member of the
list given as argument to launch_thread. It will be marked
during the conservative sweep of the stack. */
- SCM args = (SCM) p;
- scm_call_with_dynamic_root (SCM_CADR (args), SCM_CADDR (args));
+ register SCM argl = (SCM) p;
+ SCM thread = SCM_CAR (argl);
+ scheme_launch_data data;
+ data.rootcont = SCM_BOOL_F;
+ data.body = SCM_CADR (argl);
+ data.handler = SCM_CADDR (argl);
+ scm_internal_cwdr ((scm_t_catch_body) scheme_body_bootstrip,
+ &data,
+ (scm_t_catch_handler) scheme_handler_bootstrip,
+ &data,
+ (SCM_STACKITEM *) &thread);
+ SCM_SET_CELL_WORD_1 (thread, 0);
scm_thread_count--;
+ 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), argl, SCM_WNA, s_call_with_new_thread);
+ 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), argl, SCM_WNA, s_call_with_new_thread);
+ 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)), argl, SCM_WNA, s_call_with_new_thread);
+ 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);
- t = coop_create (launch_thread, (void *) 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);
+ SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t);
scm_thread_count++;
/* 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 */
+
+typedef struct c_launch_data {
+ union {
+ SCM thread;
+ SCM rootcont;
+ } u;
+ scm_t_catch_body body;
+ void *body_data;
+ scm_t_catch_handler handler;
+ void *handler_data;
+} c_launch_data;
+
+static SCM
+c_body_bootstrip (c_launch_data* data)
+{
+ /* First save the new root continuation */
+ data->u.rootcont = scm_root->rootcont;
+ return (data->body) (data->body_data);
+}
+
+static SCM
+c_handler_bootstrip (c_launch_data* data, SCM tag, SCM throw_args)
+{
+ scm_root->rootcont = data->u.rootcont;
+ return (data->handler) (data->handler_data, tag, throw_args);
+}
+
+static void
+c_launch_thread (void *p)
+{
+ register c_launch_data *data = (c_launch_data *) p;
+ /* The thread object will be GC protected by being on this stack */
+ SCM thread = data->u.thread;
+ /* 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_t_catch_body) c_body_bootstrip,
+ data,
+ (scm_t_catch_handler) c_handler_bootstrip,
+ data,
+ (SCM_STACKITEM *) &thread);
+ scm_thread_count--;
+ free ((char *) data);
+}
-#ifdef __STDC__
SCM
-scm_join_thread (SCM t)
-#else
+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_malloc (sizeof (*data));
+
+ /* 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);
+ /* Make thread. */
+ thread = scm_cell (scm_tc16_thread, 0);
+ SCM_DEFER_INTS;
+
+ data->u.thread = thread;
+ data->body = body;
+ data->body_data = body_data;
+ data->handler = handler;
+ data->handler_data = handler_data;
+
+ t = coop_create (c_launch_thread, (void *) data);
+
+ t->data = SCM_ROOT_STATE (root);
+ SCM_SET_CELL_WORD_1 (thread, (scm_t_bits) t);
+ scm_thread_count++;
+ /* Note that the following statement also could cause coop_yield.*/
+ SCM_ALLOW_INTS;
+
+ /* We're now ready for the thread to begin. */
+ coop_yield();
+
+ /* Return to old dynamic context. */
+ scm_dowinds (old_winds, - scm_ilength (old_winds));
+
+ return thread;
+}
+
SCM
-scm_join_thread (t)
- SCM t;
-#endif
+scm_join_thread (SCM thread)
+#define FUNC_NAME s_join_thread
{
- SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_join_thread);
- coop_join (SCM_THREAD_DATA (t));
+ 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);
return SCM_BOOL_T;
}
+#undef FUNC_NAME
-#ifdef __STDC__
-SCM
-scm_yield ()
-#else
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
-scm_unlock_mutex (m)
- SCM m;
-#endif
{
- 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_ASSERT (SCM_NIMP (c) && SCM_CONDVARP (c),
+ 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_mutex_unlock (SCM_MUTEX_DATA (m));
- coop_condition_variable_wait (SCM_CONDVAR_DATA (c));
+ coop_condition_variable_wait_mutex (SCM_CONDVAR_DATA (c),
+ SCM_MUTEX_DATA (m));
return SCM_BOOL_T;
}
-#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;
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff