[project @ 2005-10-21 14:02:17 by simonmar]

Big re-hash of the threaded/SMP runtime

This is a significant reworking of the threaded and SMP parts of
the runtime.  There are two overall goals here:

  - To push down the scheduler lock, reducing contention and allowing
    more parts of the system to run without locks.  In particular,
    the scheduler does not require a lock any more in the common case.

  - To improve affinity, so that running Haskell threads stick to the
    same OS threads as much as possible.

At this point we have the basic structure working, but there are some
pieces missing.  I believe it's reasonably stable - the important
parts of the testsuite pass in all the (normal,threaded,SMP) ways.

In more detail:

  - Each capability now has a run queue, instead of one global run
    queue.  The Capability and Task APIs have been completely
    rewritten; see Capability.h and Task.h for the details.

  - Each capability has its own pool of worker Tasks.  Hence, Haskell
    threads on a Capability's run queue will run on the same worker
    Task(s).  As long as the OS is doing something reasonable, this
    should mean they usually stick to the same CPU.  Another way to
    look at this is that we're assuming each Capability is associated
    with a fixed CPU.

  - What used to be StgMainThread is now part of the Task structure.
    Every OS thread in the runtime has an associated Task, and it
    can ask for its current Task at any time with myTask().

  - removed RTS_SUPPORTS_THREADS symbol, use THREADED_RTS instead
    (it is now defined for SMP too).

  - The RtsAPI has had to change; we must explicitly pass a Capability
    around now.  The previous interface assumed some global state.
    SchedAPI has also changed a lot.

  - The OSThreads API now supports thread-local storage, used to
    implement myTask(), although it could be done more efficiently
    using gcc's __thread extension when available.

  - I've moved some POSIX-specific stuff into the posix subdirectory,
    moving in the direction of separating out platform-specific
    implementations.

  - lots of lock-debugging and assertions in the runtime.  In particular,
    when DEBUG is on, we catch multiple ACQUIRE_LOCK()s, and there is
    also an ASSERT_LOCK_HELD() call.

What's missing so far:

  - I have almost certainly broken the Win32 build, will fix soon.

  - any kind of thread migration or load balancing.  This is high up
    the agenda, though.

  - various performance tweaks to do

  - throwTo and forkProcess still do not work in SMP mode

4 files changed, 194 insertions, 61 deletions

diff --git a/ghc/rts/win32/AwaitEvent.c b/ghc/rts/win32/AwaitEvent.c
index edf65df94c..6986bc9a36 100644
--- a/ghc/rts/win32/AwaitEvent.c
+++ b/ghc/rts/win32/AwaitEvent.c
@@ -16,7 +16,7 @@
 #include "Schedule.h"
 #include <windows.h>
 #include "win32/AsyncIO.h"
-#if defined(RTS_SUPPORTS_THREADS)
+#if defined(THREADED_RTS)
 #include "Capability.h"
 #endif
 
@@ -29,7 +29,7 @@ awaitEvent(rtsBool wait)
 {
   int ret;
 
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
   // Small optimisation: we don't want the waiting thread to wake
   // up straight away just because a previous returning worker has
   // called abandonRequestWait().  If the event is no longer needed,
@@ -55,18 +55,18 @@ awaitEvent(rtsBool wait)
     //
     //  - we were interrupted
     //  - new threads have arrived
-    //  - another worker wants to take over (RTS_SUPPORTS_THREADS)
+    //  - another worker wants to take over (THREADED_RTS)
 
   } while (wait
 	   && !interrupted
 	   && run_queue_hd == END_TSO_QUEUE
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
 	   && !needToYieldToReturningWorker()
 #endif
       );
 }
 
-#ifdef RTS_SUPPORTS_THREADS
+#ifdef THREADED_RTS
 void
 wakeBlockedWorkerThread()
 {
diff --git a/ghc/rts/win32/ConsoleHandler.h b/ghc/rts/win32/ConsoleHandler.h
index f64b3201ae..9c76c47787 100644
--- a/ghc/rts/win32/ConsoleHandler.h
+++ b/ghc/rts/win32/ConsoleHandler.h
@@ -15,21 +15,6 @@
  */
 
 /*
- * Function: initUserSignals()
- *
- * Initialize the console handling substrate.
- */
-extern void initUserSignals(void);
-
-/*
- * Function: initDefaultHandlers()
- *
- * Install any default signal/console handlers. Currently we install a
- * Ctrl+C handler that shuts down the RTS in an orderly manner.
- */
-extern void initDefaultHandlers(void);
-
-/*
  * Function: signals_pending() 
  * 
  * Used by the RTS to check whether new signals have been 'recently' reported.
@@ -52,30 +37,6 @@ extern StgInt stg_pending_events;
 #define anyUserHandlers() (rtsFalse)
 
 /*
- * Function: blockUserSignals()
- *
- * Temporarily block the delivery of further console events. Needed to
- * avoid race conditions when GCing the queue of outstanding handlers or
- * when emptying the queue by running the handlers.
- * 
- */
-extern void blockUserSignals(void);
-
-/*
- * Function: unblockUserSignals()
- *
- * The inverse of blockUserSignals(); re-enable the deliver of console events.
- */
-extern void unblockUserSignals(void);
-
-/*
- * Function: awaitUserSignals()
- *
- * Wait for the next console event. Currently a NOP (returns immediately.)
- */
-extern void awaitUserSignals(void);
-
-/*
  * Function: startSignalHandlers()
  *
  * Run the handlers associated with the queued up console events. Console
@@ -84,14 +45,6 @@ extern void awaitUserSignals(void);
 extern void startSignalHandlers(void);
 
 /*
- * Function: markSignalHandlers()
- *
- * Evacuate the handler queue. _Assumes_ that console event delivery
- * has already been blocked.
- */
-extern void markSignalHandlers (evac_fn evac);
-
-/*
  * Function: handleSignalsInThisThread()
  * 
  * Have current (OS) thread assume responsibility of handling console events/signals.
diff --git a/ghc/rts/win32/OSThreads.c b/ghc/rts/win32/OSThreads.c
new file mode 100644
index 0000000000..63100e45cc
--- /dev/null
+++ b/ghc/rts/win32/OSThreads.c
@@ -0,0 +1,189 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2001-2005
+ *
+ * Accessing OS threads functionality in a (mostly) OS-independent
+ * manner. 
+ *
+ * --------------------------------------------------------------------------*/
+
+#include "Rts.h"
+#if defined(THREADED_RTS)
+#include "OSThreads.h"
+#include "RtsUtils.h"
+
+/* For reasons not yet clear, the entire contents of process.h is protected 
+ * by __STRICT_ANSI__ not being defined.
+ */
+#undef __STRICT_ANSI__
+#include <process.h>
+
+/* Win32 threads and synchronisation objects */
+
+/* A Condition is represented by a Win32 Event object;
+ * a Mutex by a Mutex kernel object.
+ *
+ * ToDo: go through the defn and usage of these to
+ * make sure the semantics match up with that of 
+ * the (assumed) pthreads behaviour. This is really
+ * just a first pass at getting something compilable.
+ */
+
+void
+initCondition( Condition* pCond )
+{
+  HANDLE h =  CreateEvent(NULL, 
+			  FALSE,  /* auto reset */
+			  FALSE,  /* initially not signalled */
+			  NULL); /* unnamed => process-local. */
+  
+  if ( h == NULL ) {
+    errorBelch("initCondition: unable to create");
+  }
+  *pCond = h;
+  return;
+}
+
+void
+closeCondition( Condition* pCond )
+{
+  if ( CloseHandle(*pCond) == 0 ) {
+    errorBelch("closeCondition: failed to close");
+  }
+  return;
+}
+
+rtsBool
+broadcastCondition ( Condition* pCond )
+{
+  PulseEvent(*pCond);
+  return rtsTrue;
+}
+
+rtsBool
+signalCondition ( Condition* pCond )
+{
+    if (SetEvent(*pCond) == 0) {
+	barf("SetEvent: %d", GetLastError());
+    }
+    return rtsTrue;
+}
+
+rtsBool
+waitCondition ( Condition* pCond, Mutex* pMut )
+{
+  RELEASE_LOCK(pMut);
+  WaitForSingleObject(*pCond, INFINITE);
+  /* Hmm..use WaitForMultipleObjects() ? */
+  ACQUIRE_LOCK(pMut);
+  return rtsTrue;
+}
+
+void
+yieldThread()
+{
+  Sleep(0);
+  return;
+}
+
+void
+shutdownThread()
+{
+  _endthreadex(0);
+}
+
+int
+createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
+{
+  
+  return (_beginthreadex ( NULL,  /* default security attributes */
+			   0,
+			   startProc,
+			   param,
+			   0,
+			   (unsigned*)pId) == 0);
+}
+
+OSThreadId
+osThreadId()
+{
+  return GetCurrentThreadId();
+}
+
+void
+initMutex (Mutex* pMut)
+{
+  HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
+			   FALSE, /* not owned => initially signalled */
+			   NULL
+			   );
+  *pMut = h;
+  return;
+}
+
+void
+newThreadLocalKey (ThreadLocalKey *key)
+{
+    DWORD r;
+    r = TlsAlloc();
+    if (r == TLS_OUT_OF_INDEXES) {
+	barf("newThreadLocalKey: out of keys");
+    }
+    *key = r;
+}
+
+void *
+getThreadLocalVar (ThreadLocalKey *key)
+{
+    void *r;
+    r = TlsGetValue(*key);
+    if (r == NULL) {
+	barf("getThreadLocalVar: key not found");
+    }
+    return r;
+}
+
+void
+setThreadLocalVar (ThreadLocalKey *key, void *value)
+{
+    BOOL b;
+    b = TlsSetValue(*key, value);
+    if (!b) {
+	barf("setThreadLocalVar: %d", GetLastError());
+    }
+}
+
+
+static unsigned __stdcall
+forkOS_createThreadWrapper ( void * entry )
+{
+    Capability *cap;
+    cap = rts_lock();
+    rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
+    rts_unlock(cap);
+    return 0;
+}
+
+int
+forkOS_createThread ( HsStablePtr entry )
+{
+    unsigned long pId;
+    return (_beginthreadex ( NULL,  /* default security attributes */
+			   0,
+			   forkOS_createThreadWrapper,
+			   (void*)entry,
+			   0,
+			   (unsigned*)&pId) == 0);
+}
+
+#endif /* defined(HAVE_PTHREAD_H) */
+
+#else /* !defined(THREADED_RTS) */
+
+int
+forkOS_createThread ( HsStablePtr entry STG_UNUSED )
+{
+    return -1;
+}
+
+#endif /* !defined(THREADED_RTS) */
diff --git a/ghc/rts/win32/Ticker.h b/ghc/rts/win32/Ticker.h
deleted file mode 100644
index 6104f93a04..0000000000
--- a/ghc/rts/win32/Ticker.h
+++ /dev/null
@@ -1,9 +0,0 @@
-/*
- * RTS periodic timers (win32)
- */
-#ifndef __TICKER_H__
-#define __TICKER_H__
-extern int  startTicker( nat ms, TickProc handle_tick );
-extern int  stopTicker ( void );
-#endif /* __TICKER_H__ */
-