Fix AnnDotDot in module export
[ghc.git] / rts / win32 / OSThreads.c
1 /* ---------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 2001-2005
4 *
5 * Accessing OS threads functionality in a (mostly) OS-independent
6 * manner.
7 *
8 * --------------------------------------------------------------------------*/
9
10 #include "Rts.h"
11 #include <windows.h>
12 #if defined(THREADED_RTS)
13 #include "RtsUtils.h"
14
15 /* For reasons not yet clear, the entire contents of process.h is protected
16 * by __STRICT_ANSI__ not being defined.
17 */
18 #undef __STRICT_ANSI__
19 #include <process.h>
20
21 /* Win32 threads and synchronisation objects */
22
23 /* A Condition is represented by a Win32 Event object;
24 * a Mutex by a Mutex kernel object.
25 *
26 * ToDo: go through the defn and usage of these to
27 * make sure the semantics match up with that of
28 * the (assumed) pthreads behaviour. This is really
29 * just a first pass at getting something compilable.
30 */
31
32 void
33 initCondition( Condition* pCond )
34 {
35 HANDLE h = CreateEvent(NULL,
36 FALSE, /* auto reset */
37 FALSE, /* initially not signalled */
38 NULL); /* unnamed => process-local. */
39
40 if ( h == NULL ) {
41 sysErrorBelch("initCondition: unable to create");
42 stg_exit(EXIT_FAILURE);
43 }
44 *pCond = h;
45 return;
46 }
47
48 void
49 closeCondition( Condition* pCond )
50 {
51 if ( CloseHandle(*pCond) == 0 ) {
52 sysErrorBelch("closeCondition: failed to close");
53 }
54 return;
55 }
56
57 rtsBool
58 broadcastCondition ( Condition* pCond )
59 {
60 PulseEvent(*pCond);
61 return rtsTrue;
62 }
63
64 rtsBool
65 signalCondition ( Condition* pCond )
66 {
67 if (SetEvent(*pCond) == 0) {
68 sysErrorBelch("SetEvent");
69 stg_exit(EXIT_FAILURE);
70 }
71 return rtsTrue;
72 }
73
74 rtsBool
75 waitCondition ( Condition* pCond, Mutex* pMut )
76 {
77 RELEASE_LOCK(pMut);
78 WaitForSingleObject(*pCond, INFINITE);
79 /* Hmm..use WaitForMultipleObjects() ? */
80 ACQUIRE_LOCK(pMut);
81 return rtsTrue;
82 }
83
84 void
85 yieldThread()
86 {
87 SwitchToThread();
88 return;
89 }
90
91 void
92 shutdownThread()
93 {
94 ExitThread(0);
95 barf("ExitThread() returned"); // avoid gcc warning
96 }
97
98 int
99 createOSThread (OSThreadId* pId, char *name STG_UNUSED,
100 OSThreadProc *startProc, void *param)
101 {
102 HANDLE h;
103 h = CreateThread ( NULL, /* default security attributes */
104 0,
105 (LPTHREAD_START_ROUTINE)startProc,
106 param,
107 0,
108 pId);
109
110 if (h == 0) {
111 return 1;
112 } else {
113 // This handle leaks if we don't close it here. Perhaps we
114 // should try to keep it around to avoid needing OpenThread()
115 // later.
116 CloseHandle(h);
117 return 0;
118 }
119 }
120
121 OSThreadId
122 osThreadId()
123 {
124 return GetCurrentThreadId();
125 }
126
127 rtsBool
128 osThreadIsAlive(OSThreadId id)
129 {
130 DWORD exit_code;
131 HANDLE hdl;
132 if (!(hdl = OpenThread(THREAD_QUERY_INFORMATION,FALSE,id))) {
133 sysErrorBelch("osThreadIsAlive: OpenThread");
134 stg_exit(EXIT_FAILURE);
135 }
136 if (!GetExitCodeThread(hdl, &exit_code)) {
137 sysErrorBelch("osThreadIsAlive: GetExitCodeThread");
138 stg_exit(EXIT_FAILURE);
139 }
140 CloseHandle(hdl);
141 return (exit_code == STILL_ACTIVE);
142 }
143
144 #ifdef USE_CRITICAL_SECTIONS
145 void
146 initMutex (Mutex* pMut)
147 {
148 InitializeCriticalSectionAndSpinCount(pMut,4000);
149 }
150 void
151 closeMutex (Mutex* pMut)
152 {
153 DeleteCriticalSection(pMut);
154 }
155 #else
156 void
157 initMutex (Mutex* pMut)
158 {
159 HANDLE h = CreateMutex ( NULL, /* default sec. attributes */
160 FALSE, /* not owned => initially signalled */
161 NULL
162 );
163 *pMut = h;
164 return;
165 }
166 void
167 closeMutex (Mutex* pMut)
168 {
169 CloseHandle(*pMut);
170 }
171 #endif
172
173 void
174 newThreadLocalKey (ThreadLocalKey *key)
175 {
176 DWORD r;
177 r = TlsAlloc();
178 if (r == TLS_OUT_OF_INDEXES) {
179 barf("newThreadLocalKey: out of keys");
180 }
181 *key = r;
182 }
183
184 void *
185 getThreadLocalVar (ThreadLocalKey *key)
186 {
187 void *r;
188 r = TlsGetValue(*key);
189 #ifdef DEBUG
190 // r is allowed to be NULL - it can mean that either there was an
191 // error or the stored value is in fact NULL.
192 if (GetLastError() != NO_ERROR) {
193 sysErrorBelch("getThreadLocalVar");
194 stg_exit(EXIT_FAILURE);
195 }
196 #endif
197 return r;
198 }
199
200 void
201 setThreadLocalVar (ThreadLocalKey *key, void *value)
202 {
203 BOOL b;
204 b = TlsSetValue(*key, value);
205 if (!b) {
206 sysErrorBelch("setThreadLocalVar");
207 stg_exit(EXIT_FAILURE);
208 }
209 }
210
211 void
212 freeThreadLocalKey (ThreadLocalKey *key)
213 {
214 BOOL r;
215 r = TlsFree(*key);
216 if (r == 0) {
217 DWORD dw = GetLastError();
218 barf("freeThreadLocalKey failed: %lu", dw);
219 }
220 }
221
222
223 static unsigned __stdcall
224 forkOS_createThreadWrapper ( void * entry )
225 {
226 Capability *cap;
227 cap = rts_lock();
228 rts_evalStableIO(&cap, (HsStablePtr) entry, NULL);
229 rts_unlock(cap);
230 return 0;
231 }
232
233 int
234 forkOS_createThread ( HsStablePtr entry )
235 {
236 unsigned long pId;
237 return (_beginthreadex ( NULL, /* default security attributes */
238 0,
239 forkOS_createThreadWrapper,
240 (void*)entry,
241 0,
242 (unsigned*)&pId) == 0);
243 }
244
245 nat
246 getNumberOfProcessors (void)
247 {
248 static nat nproc = 0;
249
250 if (nproc == 0) {
251 SYSTEM_INFO si;
252 GetSystemInfo(&si);
253 nproc = si.dwNumberOfProcessors;
254 }
255
256 return nproc;
257 }
258
259 void
260 setThreadAffinity (nat n, nat m) // cap N of M
261 {
262 HANDLE hThread;
263 DWORD_PTR mask, r; // 64-bit win is required to handle more than 32 procs
264 nat nproc, i;
265
266 hThread = GetCurrentThread();
267
268 nproc = getNumberOfProcessors();
269
270 mask = 0;
271 for (i = n; i < nproc; i+=m) {
272 mask |= 1 << i;
273 }
274
275 r = SetThreadAffinityMask(hThread, mask);
276 if (r == 0) {
277 sysErrorBelch("SetThreadAffinity");
278 stg_exit(EXIT_FAILURE);
279 }
280 }
281
282 typedef BOOL (WINAPI *PCSIO)(HANDLE);
283
284 void
285 interruptOSThread (OSThreadId id)
286 {
287 HANDLE hdl;
288 PCSIO pCSIO;
289 if (!(hdl = OpenThread(THREAD_TERMINATE,FALSE,id))) {
290 sysErrorBelch("interruptOSThread: OpenThread");
291 stg_exit(EXIT_FAILURE);
292 }
293 pCSIO = (PCSIO) GetProcAddress(GetModuleHandle(TEXT("Kernel32.dll")),
294 "CancelSynchronousIo");
295 if ( NULL != pCSIO ) {
296 pCSIO(hdl);
297 } else {
298 // Nothing to do, unfortunately
299 }
300 CloseHandle(hdl);
301 }
302
303 #else /* !defined(THREADED_RTS) */
304
305 int
306 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
307 {
308 return -1;
309 }
310
311 nat getNumberOfProcessors (void)
312 {
313 return 1;
314 }
315
316 #endif /* !defined(THREADED_RTS) */
317
318 KernelThreadId kernelThreadId (void)
319 {
320 DWORD tid = GetCurrentThreadId();
321 return tid;
322 }