[project @ 2003-01-25 15:54:48 by wolfgang]
[ghc-hetmet.git] / ghc / rts / Select.c
index dc19cbf..a2ad455 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Select.c,v 1.22 2002/07/24 03:38:58 sof Exp $
+ * $Id: Select.c,v 1.23 2003/01/25 15:54:50 wolfgang Exp $
  *
  * (c) The GHC Team 1995-2002
  *
@@ -16,6 +16,7 @@
 #include "RtsFlags.h"
 #include "Itimer.h"
 #include "Signals.h"
+#include "Capability.h"
 
 # ifdef HAVE_SYS_TYPES_H
 #  include <sys/types.h>
 /* last timestamp */
 nat timestamp = 0;
 
+#ifdef RTS_SUPPORTS_THREADS
+static rtsBool isWorkerBlockedInAwaitEvent = rtsFalse;
+static rtsBool workerWakeupPending = rtsFalse;
+#ifndef mingw32_TARGET_OS
+static int workerWakeupPipe[2];
+static rtsBool workerWakeupInited = rtsFalse;
+#endif
+#endif
+
 /* There's a clever trick here to avoid problems when the time wraps
  * around.  Since our maximum delay is smaller than 31 bits of ticks
  * (it's actually 31 bits of microseconds), we can safely check
@@ -157,6 +167,15 @@ awaitEvent(rtsBool wait)
        }
       }
 
+#ifdef RTS_SUPPORTS_THREADS
+      if(!workerWakeupInited) {
+          pipe(workerWakeupPipe);
+          workerWakeupInited = rtsTrue;
+      }
+      FD_SET(workerWakeupPipe[0], &rfd);
+      maxfd = workerWakeupPipe[0] > maxfd ? workerWakeupPipe[0] : maxfd;
+#endif
+      
       /* Release the scheduler lock while we do the poll.
        * this means that someone might muck with the blocked_queue
        * while we do this, but it shouldn't matter:
@@ -169,6 +188,11 @@ awaitEvent(rtsBool wait)
        *
        * I believe none of these cases lead to trouble --SDM.
        */
+      
+#ifdef RTS_SUPPORTS_THREADS
+      isWorkerBlockedInAwaitEvent = rtsTrue;
+      workerWakeupPending = rtsFalse;
+#endif
       RELEASE_LOCK(&sched_mutex);
 
       /* Check for any interesting events */
@@ -206,10 +230,17 @@ awaitEvent(rtsBool wait)
            }
          }
 #else /* on mingwin */
+#ifdef RTS_SUPPORTS_THREADS
+      isWorkerBlockedInAwaitEvent = rtsTrue;
+#endif
+      RELEASE_LOCK(&sched_mutex);
       while (1) {
          Sleep(0); /* don't busy wait */
 #endif /* mingw32_TARGET_OS */
          ACQUIRE_LOCK(&sched_mutex);
+#ifdef RTS_SUPPORTS_THREADS
+          isWorkerBlockedInAwaitEvent = rtsFalse;
+#endif
 
 #ifndef mingw32_TARGET_OS
          /* We got a signal; could be one of ours.  If so, we need
@@ -242,6 +273,18 @@ awaitEvent(rtsBool wait)
              return; /* still hold the lock */
          }
          
+#ifdef RTS_SUPPORTS_THREADS
+         /* If another worker thread wants to take over,
+          * return to the scheduler
+          */
+         if (needToYieldToReturningWorker()) {
+             return; /* still hold the lock */
+         }
+#endif
+         
+#ifdef RTS_SUPPORTS_THREADS
+          isWorkerBlockedInAwaitEvent = rtsTrue;
+#endif
          RELEASE_LOCK(&sched_mutex);
       }
 
@@ -287,6 +330,43 @@ awaitEvent(rtsBool wait)
              blocked_queue_tl = prev;
          }
       }
-
+      
+#if defined(RTS_SUPPORTS_THREADS) && !defined(mingw32_TARGET_OS)
+       // if we were woken up by wakeBlockedWorkerThread,
+       // read the dummy byte from the pipe
+      if(select_succeeded && FD_ISSET(workerWakeupPipe[0], &rfd)) {
+          unsigned char dummy;
+          wait = rtsFalse;
+          read(workerWakeupPipe[0],&dummy,1);
+      }
+#endif
     } while (wait && !interrupted && run_queue_hd == END_TSO_QUEUE);
 }
+
+
+#ifdef RTS_SUPPORTS_THREADS
+/* wakeBlockedWorkerThread
+ *
+ * If a worker thread is currently blocked within awaitEvent,
+ * wake it.
+ * Must be called with sched_mutex held.
+ */
+
+void
+wakeBlockedWorkerThread()
+{
+#ifndef mingw32_TARGET_OS
+    if(isWorkerBlockedInAwaitEvent && !workerWakeupPending) {
+       unsigned char dummy = 42;       // Any value will do here
+       
+                       // write something so that select() wakes up
+       write(workerWakeupPipe[1],&dummy,1);
+       workerWakeupPending = rtsTrue;
+    }
+#else
+       // The Win32 implementation currently uses a polling loop,
+       // so there is no need to explicitly wake it
+#endif
+}
+
+#endif