* scheme-io.texi: Removed obsolete section Binary IO. Added
[bpt/guile.git] / libguile / coop.c
index f676ea0..a6ef33e 100644 (file)
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+/*     Copyright (C) 1995, 1996, 1997, 1998, 1999, 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
  * If you do not wish that, delete this exception notice.  */
 \f
 
-/* $Id: coop.c,v 1.18 2000-03-12 01:48:04 mdj Exp $ */
+/* $Id: coop.c,v 1.27 2001-03-10 03:09:07 mdj Exp $ */
 
 /* Cooperative thread library, based on QuickThreads */
 
+#include <stdio.h>
+
 #ifdef HAVE_UNISTD_H 
 #include <unistd.h>
 #endif
 
 #include <errno.h>
 
-#include <qt.h>
-#include "eval.h"
+#include "qt/qt.h"
+#include "libguile/eval.h"
 
 \f/* #define COOP_STKSIZE (0x10000) */
 #define COOP_STKSIZE (scm_eval_stack)
@@ -88,12 +90,14 @@ coop_qget (coop_q_t *q)
 
   t = q->t.next;
   q->t.next = t->next;
-  if (t->next == &q->t) {
-    if (t == &q->t) {          /* If it was already empty .. */
-      return (NULL);           /* .. say so. */
+  if (t->next == &q->t)
+    {
+      if (t == &q->t)
+       {                       /* If it was already empty .. */
+         return NULL;          /* .. say so. */
+       }
+      q->tail = &q->t;         /* Else now it is empty. */
     }
-    q->tail = &q->t;           /* Else now it is empty. */
-  }
   return (t);
 }
 
@@ -160,23 +164,67 @@ coop_q_t coop_global_allq;      /* A queue of all threads. */
 static coop_t coop_global_main; /* Thread for the process. */
 coop_t *coop_global_curr;      /* Currently-executing thread. */
 
+#ifdef GUILE_PTHREAD_COMPAT
+static coop_q_t coop_deadq;
+static int coop_quitting_p = -1;
+static pthread_cond_t coop_cond_quit;
+static pthread_cond_t coop_cond_create;
+static pthread_mutex_t coop_mutex_create;
+static pthread_t coop_mother;
+static coop_t *coop_child;
+#endif
+
 static void *coop_starthelp (qt_t *old, void *ignore0, void *ignore1);
 static void coop_only (void *pu, void *pt, qt_userf_t *f);
 static void *coop_aborthelp (qt_t *sp, void *old, void *null);
 static void *coop_yieldhelp (qt_t *sp, void *old, void *blockq);
 
 
+/* called on process termination.  */
+#ifdef HAVE_ATEXIT
+static void
+coop_finish (void)
+#else
+#ifdef HAVE_ON_EXIT
+extern int on_exit (void (*procp) (), int arg);
+
+static void
+coop_finish (int status, void *arg)
+#else
+#error Dont know how to setup a cleanup handler on your system.
+#endif
+#endif
+{
+#ifdef GUILE_PTHREAD_COMPAT
+  coop_quitting_p = 1;
+  pthread_cond_signal (&coop_cond_create);
+  pthread_cond_broadcast (&coop_cond_quit);
+#endif
+}
+
 void
-coop_init()
+coop_init ()
 {
   coop_qinit (&coop_global_runq);
   coop_qinit (&coop_global_sleepq);
   coop_qinit (&coop_tmp_queue);
   coop_qinit (&coop_global_allq);
   coop_global_curr = &coop_global_main;
+#ifdef GUILE_PTHREAD_COMPAT
+  coop_qinit (&coop_deadq);
+  pthread_cond_init (&coop_cond_quit, NULL);
+  pthread_cond_init (&coop_cond_create, NULL);
+  pthread_mutex_init (&coop_mutex_create, NULL);
+#endif
+#ifdef HAVE_ATEXIT
+  atexit (coop_finish);
+#else
+#ifdef HAVE_ON_EXIT
+  on_exit (coop_finish, 0);
+#endif
+#endif
 }
 
-
 /* Return the next runnable thread. If no threads are currently runnable,
    and there are sleeping threads - wait until one wakes up. Otherwise,
    return NULL. */
@@ -502,37 +550,100 @@ coop_condition_variable_destroy (coop_c *c)
 }
 
 #ifdef GUILE_PTHREAD_COMPAT
+
+/* 1K room for the cond wait routine */
+#ifdef SCM_STACK_GROWS_UP
+#define COOP_STACK_ROOM (256)
+#else
+#define COOP_STACK_ROOM (-256)
+#endif
+
 static void *
 dummy_start (void *coop_thread)
 {
   coop_t *t = (coop_t *) coop_thread;
-  t->sto = &t + 1;
+  int res;
+  t->sp = (qt_t *) (&t + COOP_STACK_ROOM);
   pthread_mutex_init (&t->dummy_mutex, NULL);
   pthread_mutex_lock (&t->dummy_mutex);
-  pthread_cond_init (&t->dummy_cond, NULL);
-  pthread_cond_wait (&t->dummy_cond, &t->dummy_mutex);
+  coop_child = 0;
+  do
+    res = pthread_cond_wait (&coop_cond_quit, &t->dummy_mutex);
+  while (res == EINTR);
   return 0;
 }
+
+static void *
+mother (void *dummy)
+{
+  pthread_mutex_lock (&coop_mutex_create);
+  while (!coop_quitting_p)
+    {
+      int res;
+      pthread_create (&coop_child->dummy_thread,
+                     NULL,
+                     dummy_start,
+                     coop_child);
+      do
+       res = pthread_cond_wait (&coop_cond_create, &coop_mutex_create);
+      while (res == EINTR);
+    }
+  return 0;
+}
+
 #endif
 
 coop_t *
 coop_create (coop_userf_t *f, void *pu)
 {
   coop_t *t;
+#ifndef GUILE_PTHREAD_COMPAT
   void *sto;
+#endif
 
-  t = malloc (sizeof(coop_t));
+#ifdef GUILE_PTHREAD_COMPAT
+  t = coop_qget (&coop_deadq);
+  if (t)
+    {
+      t->sp = t->base;
+      t->specific = 0;
+      t->n_keys = 0;
+    }
+  else
+#endif
+    {
+      t = malloc (sizeof (coop_t));
 
-  t->data = NULL;
-  t->n_keys = 0;
+      t->specific = NULL;
+      t->n_keys = 0;
 #ifdef GUILE_PTHREAD_COMPAT
-  pthread_create (&t->dummy_thread, NULL, dummy_start, t);
+      coop_child = t;
+      if (coop_quitting_p < 0)
+       {
+         coop_quitting_p = 0;
+         /* We can't create threads ourselves since the pthread
+          * corresponding to this stack might be sleeping.
+          */
+         pthread_create (&coop_mother, NULL, mother, NULL);
+       }
+      else
+       {
+         pthread_cond_signal (&coop_cond_create);
+       }
+      /* We can't use a pthreads condition variable since "this"
+       * pthread could already be asleep.  We can't use a COOP
+       * condition variable because they are not safe against
+       * pre-emptive switching.
+       */
+      while (coop_child)
+       usleep (0);
 #else
-  t->sto = malloc (COOP_STKSIZE);
+      t->sto = malloc (COOP_STKSIZE);
+      sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
+      t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
 #endif
-  sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
-  t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
-  t->base = t->sp;
+      t->base = t->sp;
+    }
   t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only);
   t->joining = NULL;
   coop_qput (&coop_global_runq, t);
@@ -565,7 +676,7 @@ coop_abort ()
        {
          coop_qput (&coop_global_runq, newthread);
        }
-      free(coop_global_curr->joining);
+      free (coop_global_curr->joining);
     }
 
 #ifdef GUILE_ISELECT
@@ -577,13 +688,10 @@ coop_abort ()
 #else
   newthread = coop_next_runnable_thread();
 #endif
-  coop_all_qremove(&coop_global_allq, coop_global_curr);
+  coop_all_qremove (&coop_global_allq, coop_global_curr);
   old = coop_global_curr;
   coop_global_curr = newthread;
-#ifdef GUILE_PTHREAD_COMPAT
-  pthread_cond_signal (&old->dummy_cond);
-#endif
-  QT_ABORT (coop_aborthelp, old, (void *)NULL, newthread->sp);
+  QT_ABORT (coop_aborthelp, old, (void *) NULL, newthread->sp);
 }
 
 
@@ -592,13 +700,15 @@ coop_aborthelp (qt_t *sp, void *old, void *null)
 {
   coop_t *oldthread = (coop_t *) old;
 
+  if (oldthread->specific)
+    free (oldthread->specific);
+#ifndef GUILE_PTHREAD_COMPAT
   free (oldthread->sto);
-
-  /* "old" is freed in scm_threads_thread_die().
-     Marking old->base NULL indicates that this thread is dead */
-
-  oldthread->base = NULL;
-
+  free (oldthread);
+#else
+  coop_qput (&coop_deadq, oldthread);
+#endif
+  
   return NULL;
 }
 
@@ -608,10 +718,6 @@ coop_join(coop_t *t)
 {
   coop_t *old, *newthread;
   
-  /* Check if t is already finished */
-  if (t->base == NULL)
-    return;
-
   /* Create a join list if necessary */
   if (t->joining == NULL)
     {
@@ -739,3 +845,9 @@ scm_thread_usleep (unsigned long usec)
 }
 
 #endif /* GUILE_ISELECT */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/