summaryrefslogtreecommitdiff
path: root/libguile/coop-threads.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/coop-threads.c')
-rw-r--r--libguile/coop-threads.c439
1 files changed, 439 insertions, 0 deletions
diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c
new file mode 100644
index 000000000..a8860fc62
--- /dev/null
+++ b/libguile/coop-threads.c
@@ -0,0 +1,439 @@
+/* Copyright (C) 1995, 1996 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, 675 Mass Ave, Cambridge, MA 02139, 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 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.
+ *
+ * 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.
+ */
+
+
+#include "coop-threads.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"
+
+/* A count-down counter used to determine when to switch
+ contexts */
+size_t scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
+
+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;
+
+ coop_global_main.sto = i;
+ 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 */
+}
+
+#ifdef __STDC__
+void
+scm_threads_mark_stacks ()
+#else
+void
+scm_threads_mark_stacks ()
+#endif
+{
+ coop_t *thread;
+
+ for (thread = coop_global_allq.t.all_next;
+ thread != NULL; thread = thread->all_next)
+ {
+ if (thread == coop_global_curr)
+ {
+ /* Active thread */
+ /* stack_len is long rather than sizet in order to guarantee
+ that &stack_len is long aligned */
+#ifdef 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
+ * 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,
+ ((scm_sizet) sizeof scm_save_regs_gc_mark
+ / sizeof (SCM_STACKITEM)));
+
+ scm_mark_locations (((size_t) thread->base,
+ (sizet) stack_len));
+#else
+ long stack_len = ((SCM_STACKITEM *) thread->base -
+ (SCM_STACKITEM *) (&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
+ * 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,
+ ((scm_sizet) sizeof scm_save_regs_gc_mark
+ / sizeof (SCM_STACKITEM)));
+
+ scm_mark_locations ((SCM_STACKITEM *) &thread,
+ stack_len);
+#endif
+ }
+ else
+ {
+ /* Suspended thread */
+#ifdef STACK_GROWS_UP
+ long stack_len = ((SCM_STACKITEM *) (thread->sp) -
+ (SCM_STACKITEM *) thread->base);
+
+ scm_mark_locations ((size_t)thread->base,
+ (sizet) stack_len);
+#else
+ long stack_len = ((SCM_STACKITEM *) thread->base -
+ (SCM_STACKITEM *) (thread->sp));
+
+ /* Registers are already on the stack. No need to mark. */
+
+ scm_mark_locations ((SCM_STACKITEM *) (size_t)thread->sp,
+ stack_len);
+#endif
+ }
+
+ /* Mark this thread's root */
+ scm_gc_mark (((scm_root_state *) thread->data) -> handle);
+ }
+}
+
+#ifdef __STDC__
+void
+launch_thread (void *p)
+#else
+void
+launch_thread (p)
+ void *p;
+#endif
+{
+ /* 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));
+ scm_thread_count--;
+}
+
+#ifdef __STDC__
+SCM
+scm_call_with_new_thread (SCM argl)
+#else
+SCM
+scm_call_with_new_thread (argl)
+ SCM argl;
+#endif
+{
+ SCM thread;
+
+ /* Check arguments. */
+ {
+ register SCM args = argl;
+ SCM thunk, handler;
+ SCM_ASSERT (SCM_NIMP (args), argl, SCM_WNA, s_call_with_new_thread);
+ 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);
+ 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);
+ }
+
+ /* Make new thread. */
+ {
+ coop_t *t;
+ SCM root, old_winds;
+
+ /* 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. */
+ SCM_NEWCELL (thread);
+ SCM_DEFER_INTS;
+ SCM_SETCAR (thread, scm_tc16_thread);
+ argl = scm_cons (thread, argl);
+ t = coop_create (launch_thread, (void *) argl);
+ t->data = SCM_ROOT_STATE (root);
+ SCM_SETCDR (thread, 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;
+}
+
+#ifdef __STDC__
+SCM
+scm_join_thread (SCM t)
+#else
+SCM
+scm_join_thread (t)
+ SCM t;
+#endif
+{
+ SCM_ASSERT (SCM_NIMP (t) && SCM_THREADP (t), t, SCM_ARG1, s_join_thread);
+ coop_join (SCM_THREAD_DATA (t));
+ return SCM_BOOL_T;
+}
+
+#ifdef __STDC__
+SCM
+scm_yield ()
+#else
+SCM
+scm_yield ()
+#endif
+{
+ /* Yield early */
+ scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
+ coop_yield();
+
+ return SCM_BOOL_T;
+}
+
+#ifdef __STDC__
+SCM
+scm_single_thread_p ()
+#else
+SCM
+scm_single_thread_p ()
+#endif
+{
+ 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 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);
+ 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);
+ 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);
+ coop_mutex_unlock(SCM_MUTEX_DATA (m));
+
+ /* Yield early */
+ scm_switch_counter = SCM_THREAD_SWITCH_COUNT;
+ coop_yield();
+
+ return SCM_BOOL_T;
+}
+
+#ifdef __STDC__
+SCM
+scm_make_condition_variable ()
+#else
+SCM
+scm_make_condition_variable ()
+#endif
+{
+ 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;
+ 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),
+ c,
+ SCM_ARG1,
+ s_wait_condition_variable);
+ SCM_ASSERT (SCM_NIMP (m) && 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));
+ 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),
+ c,
+ SCM_ARG1,
+ s_signal_condition_variable);
+ coop_condition_variable_signal (SCM_CONDVAR_DATA (c));
+ return SCM_BOOL_T;
+}