* coop-threads.c, threads.h (scm_spawn_thread): New function.

Can spawn a thread from application C code.

diff --git a/NEWS b/NEWS
index 9561d3e..3913f57 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -410,6 +410,15 @@ the stack to be saved automatically into the variable `the-last-stack'
 use advanced error reporting, such as calling scm_display_error and
 scm_display_backtrace.  (They both take a stack object as argument.)
 
+** Function: SCM scm_spawn_thread (scm_catch_body_t body,
+                                  void *body_data,
+                                  scm_catch_handler_t handler,
+                                  void *handler_data)
+
+Spawns a new thread.  It does a job similar to
+scm_call_with_new_thread but takes arguments more suitable when
+spawning threads from application C code.
+
 ** The hook scm_error_callback has been removed.  It was originally
 intended as a way for the user to install his own error handler.  But
 that method works badly since it intervenes between throw and catch,

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 6ca6828..34398aa 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,8 @@
+1998-01-23  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+       * coop-threads.c, threads.h (scm_spawn_thread): New function.
+       Can spawn a thread from application C code.
+
 1998-01-20  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
 
        * gh.h, gh_data.c (gh_doubles2scm, gh_doubles2dvect,

diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c
index b3fad95..9e1ad75 100644 (file)
--- a/libguile/coop-threads.c
+++ b/libguile/coop-threads.c
@@ -204,14 +204,20 @@ scm_threads_mark_stacks ()
     }
 }
 
-#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 */
+
+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
@@ -274,7 +280,7 @@ scm_call_with_new_thread (argl)
     SCM_DEFER_INTS;
     SCM_SETCAR (thread, scm_tc16_thread);
     argl = scm_cons (thread, argl);
-    t = coop_create (launch_thread, (void *) argl);
+    t = coop_create (scheme_launch_thread, (void *) argl);
     t->data = SCM_ROOT_STATE (root);
     SCM_SETCDR (thread, t);
     scm_thread_count++;
@@ -291,6 +297,79 @@ scm_call_with_new_thread (argl)
   return thread;
 }
 
+/* This is the second thread spawning mechanism: threads from C */
+
+struct thread_args {
+  SCM thread;
+  scm_catch_body_t body;
+  void *body_data;
+  scm_catch_handler_t handler;
+  void *handler_data;
+};
+
+static void
+c_launch_thread (void *p)
+{
+  struct thread_args *args = (struct thread_args *) p;
+  /* The thread object will be GC protected by being on this stack */
+  SCM thread = args->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 (args->body,
+                    args->body_data,
+                    args->handler,
+                    args->handler_data,
+                    &thread);
+  scm_thread_count--;
+  scm_must_free ((char *) args);
+}
+
+SCM
+scm_spawn_thread (scm_catch_body_t body, void *body_data,
+                 scm_catch_handler_t handler, void *handler_data)
+{
+  SCM thread;
+  coop_t *t;
+  SCM root, old_winds;
+  struct thread_args *args =
+    (struct thread_args *) scm_must_malloc (sizeof (*args),
+                                           "scm_spawn_thread");
+  
+  /* 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);
+
+  args->thread = thread;
+  args->body = body;
+  args->body_data = body_data;
+  args->handler = handler;
+  args->handler_data = handler_data;
+  
+  t = coop_create (c_launch_thread, (void *) args);
+  
+  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)

diff --git a/libguile/threads.h b/libguile/threads.h
index 0c23293..344d305 100644 (file)
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -73,6 +73,9 @@ SCM scm_threads_lock_mutex SCM_P ((SCM));
 SCM scm_threads_unlock_mutex SCM_P ((SCM));
 SCM scm_threads_monitor SCM_P ((void));
 
+SCM scm_spawn_thread (scm_catch_body_t body, void *body_data,
+                     scm_catch_handler_t handler, void *handler_data);
+
 #if 0
 /* These don't work any more.  */ 
 #ifdef USE_MIT_PTHREADS