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"
18 /* For reasons not yet clear, the entire contents of process.h is protected
19 * by __STRICT_ANSI__ not being defined.
21 #undef __STRICT_ANSI__
24 /* Win32 threads and synchronisation objects */
26 /* A Condition is represented by a Win32 Event object;
27 * a Mutex by a Mutex kernel object.
29 * ToDo: go through the defn and usage of these to
30 * make sure the semantics match up with that of
31 * the (assumed) pthreads behaviour. This is really
32 * just a first pass at getting something compilable.
36 initCondition( Condition* pCond )
38 HANDLE h = CreateEvent(NULL,
39 FALSE, /* auto reset */
40 FALSE, /* initially not signalled */
41 NULL); /* unnamed => process-local. */
44 sysErrorBelch("initCondition: unable to create");
45 stg_exit(EXIT_FAILURE);
52 closeCondition( Condition* pCond )
54 if ( CloseHandle(*pCond) == 0 ) {
55 sysErrorBelch("closeCondition: failed to close");
61 broadcastCondition ( Condition* pCond )
68 signalCondition ( Condition* pCond )
70 if (SetEvent(*pCond) == 0) {
71 sysErrorBelch("SetEvent");
72 stg_exit(EXIT_FAILURE);
78 waitCondition ( Condition* pCond, Mutex* pMut )
81 WaitForSingleObject(*pCond, INFINITE);
82 /* Hmm..use WaitForMultipleObjects() ? */
101 createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
104 return (_beginthreadex ( NULL, /* default security attributes */
106 (unsigned (__stdcall *)(void *)) startProc,
109 (unsigned*)pId) == 0);
115 return GetCurrentThreadId();
119 osThreadIsAlive(OSThreadId id)
123 if (!(hdl = OpenThread(THREAD_QUERY_INFORMATION,FALSE,id))) {
124 sysErrorBelch("osThreadIsAlive: OpenThread");
125 stg_exit(EXIT_FAILURE);
127 if (!GetExitCodeThread(hdl, &exit_code)) {
128 sysErrorBelch("osThreadIsAlive: GetExitCodeThread");
129 stg_exit(EXIT_FAILURE);
131 return (exit_code == STILL_ACTIVE);
134 #ifdef USE_CRITICAL_SECTIONS
136 initMutex (Mutex* pMut)
138 InitializeCriticalSectionAndSpinCount(pMut,4000);
141 closeMutex (Mutex* pMut)
143 DeleteCriticalSection(pMut);
147 initMutex (Mutex* pMut)
149 HANDLE h = CreateMutex ( NULL, /* default sec. attributes */
150 FALSE, /* not owned => initially signalled */
157 closeMutex (Mutex* pMut)
164 newThreadLocalKey (ThreadLocalKey *key)
168 if (r == TLS_OUT_OF_INDEXES) {
169 barf("newThreadLocalKey: out of keys");
175 getThreadLocalVar (ThreadLocalKey *key)
178 r = TlsGetValue(*key);
180 // r is allowed to be NULL - it can mean that either there was an
181 // error or the stored value is in fact NULL.
182 if (GetLastError() != NO_ERROR) {
183 sysErrorBelch("getThreadLocalVar");
184 stg_exit(EXIT_FAILURE);
191 setThreadLocalVar (ThreadLocalKey *key, void *value)
194 b = TlsSetValue(*key, value);
196 sysErrorBelch("setThreadLocalVar");
197 stg_exit(EXIT_FAILURE);
202 freeThreadLocalKey (ThreadLocalKey *key)
207 DWORD dw = GetLastError();
208 barf("freeThreadLocalKey failed: %lu", dw);
213 static unsigned __stdcall
214 forkOS_createThreadWrapper ( void * entry )
218 cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
224 forkOS_createThread ( HsStablePtr entry )
227 return (_beginthreadex ( NULL, /* default security attributes */
229 forkOS_createThreadWrapper,
232 (unsigned*)&pId) == 0);
235 #else /* !defined(THREADED_RTS) */
238 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
243 #endif /* !defined(THREADED_RTS) */