X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2Fwin32%2FOSThreads.c;fp=rts%2Fwin32%2FOSThreads.c;h=c772be38f4ed3e7b6400280153ff9f4dbcc56473;hp=0000000000000000000000000000000000000000;hb=0065d5ab628975892cea1ec7303f968c3338cbe1;hpb=28a464a75e14cece5db40f2765a29348273ff2d2

diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c
new file mode 100644
index 0000000..c772be3
--- /dev/null
+++ b/rts/win32/OSThreads.c
@@ -0,0 +1,199 @@
+/* ---------------------------------------------------------------------------
+ *
+ * (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,
+			   (unsigned (__stdcall *)(void *)) startProc,
+			   param,
+			   0,
+			   (unsigned*)pId) == 0);
+}
+
+OSThreadId
+osThreadId()
+{
+  return GetCurrentThreadId();
+}
+
+#ifdef USE_CRITICAL_SECTIONS
+void
+initMutex (Mutex* pMut)
+{
+    InitializeCriticalSectionAndSpinCount(pMut,4000);
+}
+#else
+void
+initMutex (Mutex* pMut)
+{
+  HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
+			   FALSE, /* not owned => initially signalled */
+			   NULL
+			   );
+  *pMut = h;
+  return;
+}
+#endif
+
+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);
+#ifdef DEBUG
+    // r is allowed to be NULL - it can mean that either there was an
+    // error or the stored value is in fact NULL.
+    if (GetLastError() != NO_ERROR) {
+	barf("getThreadLocalVar: key not found");
+    }
+#endif
+    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();
+    cap = 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);
+}
+
+#else /* !defined(THREADED_RTS) */
+
+int
+forkOS_createThread ( HsStablePtr entry STG_UNUSED )
+{
+    return -1;
+}
+
+#endif /* !defined(THREADED_RTS) */