1 /* ---------------------------------------------------------------------------
3 * (c) The GHC Team, 2001-2005
5 * Accessing OS threads functionality in a (mostly) OS-independent
8 * --------------------------------------------------------------------------*/
10 #define _WIN32_WINNT 0x0500
13 #if defined(THREADED_RTS)
14 #include "OSThreads.h"
17 /* For reasons not yet clear, the entire contents of process.h is protected
18 * by __STRICT_ANSI__ not being defined.
20 #undef __STRICT_ANSI__
23 /* Win32 threads and synchronisation objects */
25 /* A Condition is represented by a Win32 Event object;
26 * a Mutex by a Mutex kernel object.
28 * ToDo: go through the defn and usage of these to
29 * make sure the semantics match up with that of
30 * the (assumed) pthreads behaviour. This is really
31 * just a first pass at getting something compilable.
35 initCondition( Condition* pCond )
37 HANDLE h = CreateEvent(NULL,
38 FALSE, /* auto reset */
39 FALSE, /* initially not signalled */
40 NULL); /* unnamed => process-local. */
43 sysErrorBelch("initCondition: unable to create");
44 stg_exit(EXIT_FAILURE);
51 closeCondition( Condition* pCond )
53 if ( CloseHandle(*pCond) == 0 ) {
54 sysErrorBelch("closeCondition: failed to close");
60 broadcastCondition ( Condition* pCond )
67 signalCondition ( Condition* pCond )
69 if (SetEvent(*pCond) == 0) {
70 sysErrorBelch("SetEvent");
71 stg_exit(EXIT_FAILURE);
77 waitCondition ( Condition* pCond, Mutex* pMut )
80 WaitForSingleObject(*pCond, INFINITE);
81 /* Hmm..use WaitForMultipleObjects() ? */
100 createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
103 return (_beginthreadex ( NULL, /* default security attributes */
105 (unsigned (__stdcall *)(void *)) startProc,
108 (unsigned*)pId) == 0);
114 return GetCurrentThreadId();
118 osThreadIsAlive(OSThreadId id)
122 if (!(hdl = OpenThread(THREAD_QUERY_INFORMATION,FALSE,id))) {
123 sysErrorBelch("osThreadIsAlive: OpenThread");
124 stg_exit(EXIT_FAILURE);
126 if (!GetExitCodeThread(hdl, &exit_code)) {
127 sysErrorBelch("osThreadIsAlive: GetExitCodeThread");
128 stg_exit(EXIT_FAILURE);
130 return (exit_code == STILL_ACTIVE);
133 #ifdef USE_CRITICAL_SECTIONS
135 initMutex (Mutex* pMut)
137 InitializeCriticalSectionAndSpinCount(pMut,4000);
140 closeMutex (Mutex* pMut)
142 DeleteCriticalSection(pMut);
146 initMutex (Mutex* pMut)
148 HANDLE h = CreateMutex ( NULL, /* default sec. attributes */
149 FALSE, /* not owned => initially signalled */
156 closeMutex (Mutex* pMut)
163 newThreadLocalKey (ThreadLocalKey *key)
167 if (r == TLS_OUT_OF_INDEXES) {
168 barf("newThreadLocalKey: out of keys");
174 getThreadLocalVar (ThreadLocalKey *key)
177 r = TlsGetValue(*key);
179 // r is allowed to be NULL - it can mean that either there was an
180 // error or the stored value is in fact NULL.
181 if (GetLastError() != NO_ERROR) {
182 sysErrorBelch("getThreadLocalVar");
183 stg_exit(EXIT_FAILURE);
190 setThreadLocalVar (ThreadLocalKey *key, void *value)
193 b = TlsSetValue(*key, value);
195 sysErrorBelch("setThreadLocalVar");
196 stg_exit(EXIT_FAILURE);
201 freeThreadLocalKey (ThreadLocalKey *key)
206 DWORD dw = GetLastError();
207 barf("freeThreadLocalKey failed: %lu", dw);
212 static unsigned __stdcall
213 forkOS_createThreadWrapper ( void * entry )
217 cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
223 forkOS_createThread ( HsStablePtr entry )
226 return (_beginthreadex ( NULL, /* default security attributes */
228 forkOS_createThreadWrapper,
231 (unsigned*)&pId) == 0);
234 #else /* !defined(THREADED_RTS) */
237 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
242 #endif /* !defined(THREADED_RTS) */