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