OSThreads.c 5.29 KB
Newer Older
sof's avatar
sof committed
1 2
/* ---------------------------------------------------------------------------
 *
3
 * (c) The GHC Team, 2001-2005
sof's avatar
sof committed
4 5 6 7 8
 *
 * Accessing OS threads functionality in a (mostly) OS-independent
 * manner. 
 *
 * --------------------------------------------------------------------------*/
9

Simon Marlow's avatar
Simon Marlow committed
10 11
#define _WIN32_WINNT 0x0500

sof's avatar
sof committed
12
#include "Rts.h"
13
#if defined(THREADED_RTS)
sof's avatar
sof committed
14
#include "RtsUtils.h"
Ian Lynagh's avatar
Ian Lynagh committed
15
#include <windows.h>
sof's avatar
sof committed
16

17 18 19 20
/* For reasons not yet clear, the entire contents of process.h is protected 
 * by __STRICT_ANSI__ not being defined.
 */
#undef __STRICT_ANSI__
sof's avatar
sof committed
21 22
#include <process.h>

sof's avatar
sof committed
23 24
/* Win32 threads and synchronisation objects */

sof's avatar
sof committed
25 26
/* A Condition is represented by a Win32 Event object;
 * a Mutex by a Mutex kernel object.
sof's avatar
sof committed
27 28 29 30 31
 *
 * 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.
sof's avatar
sof committed
32 33
 */

sof's avatar
sof committed
34 35
void
initCondition( Condition* pCond )
sof's avatar
sof committed
36 37
{
  HANDLE h =  CreateEvent(NULL, 
sof's avatar
sof committed
38 39
			  FALSE,  /* auto reset */
			  FALSE,  /* initially not signalled */
sof's avatar
sof committed
40 41
			  NULL); /* unnamed => process-local. */
  
sof's avatar
sof committed
42
  if ( h == NULL ) {
43 44
      sysErrorBelch("initCondition: unable to create");
      stg_exit(EXIT_FAILURE);
sof's avatar
sof committed
45 46
  }
  *pCond = h;
sof's avatar
sof committed
47 48 49
  return;
}

sof's avatar
sof committed
50 51
void
closeCondition( Condition* pCond )
sof's avatar
sof committed
52
{
sof's avatar
sof committed
53
  if ( CloseHandle(*pCond) == 0 ) {
54
      sysErrorBelch("closeCondition: failed to close");
sof's avatar
sof committed
55
  }
sof's avatar
sof committed
56 57 58 59
  return;
}

rtsBool
sof's avatar
sof committed
60
broadcastCondition ( Condition* pCond )
sof's avatar
sof committed
61
{
sof's avatar
sof committed
62 63
  PulseEvent(*pCond);
  return rtsTrue;
sof's avatar
sof committed
64 65 66
}

rtsBool
sof's avatar
sof committed
67
signalCondition ( Condition* pCond )
sof's avatar
sof committed
68
{
69
    if (SetEvent(*pCond) == 0) {
70 71
	sysErrorBelch("SetEvent");
	stg_exit(EXIT_FAILURE);
72 73
    }
    return rtsTrue;
sof's avatar
sof committed
74 75 76
}

rtsBool
sof's avatar
sof committed
77
waitCondition ( Condition* pCond, Mutex* pMut )
sof's avatar
sof committed
78
{
79
  RELEASE_LOCK(pMut);
sof's avatar
sof committed
80 81
  WaitForSingleObject(*pCond, INFINITE);
  /* Hmm..use WaitForMultipleObjects() ? */
82
  ACQUIRE_LOCK(pMut);
sof's avatar
sof committed
83
  return rtsTrue;
sof's avatar
sof committed
84 85
}

sof's avatar
sof committed
86 87 88
void
yieldThread()
{
89
  SwitchToThread();
sof's avatar
sof committed
90 91 92
  return;
}

sof's avatar
sof committed
93 94
void
shutdownThread()
sof's avatar
sof committed
95
{
sof's avatar
sof committed
96
  _endthreadex(0);
Simon Marlow's avatar
Simon Marlow committed
97
  barf("_endthreadex returned"); // avoid gcc warning
sof's avatar
sof committed
98 99
}

sof's avatar
sof committed
100
int
101
createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
sof's avatar
sof committed
102
{
sof's avatar
sof committed
103
  
sof's avatar
sof committed
104 105
  return (_beginthreadex ( NULL,  /* default security attributes */
			   0,
106
			   (unsigned (__stdcall *)(void *)) startProc,
107
			   param,
sof's avatar
sof committed
108
			   0,
sof's avatar
sof committed
109
			   (unsigned*)pId) == 0);
sof's avatar
sof committed
110 111
}

sof's avatar
sof committed
112 113
OSThreadId
osThreadId()
sof's avatar
sof committed
114
{
sof's avatar
sof committed
115
  return GetCurrentThreadId();
sof's avatar
sof committed
116 117
}

Simon Marlow's avatar
Simon Marlow committed
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
rtsBool
osThreadIsAlive(OSThreadId id)
{
    DWORD exit_code;
    HANDLE hdl;
    if (!(hdl = OpenThread(THREAD_QUERY_INFORMATION,FALSE,id))) {
        sysErrorBelch("osThreadIsAlive: OpenThread");
        stg_exit(EXIT_FAILURE);
    }
    if (!GetExitCodeThread(hdl, &exit_code)) {
        sysErrorBelch("osThreadIsAlive: GetExitCodeThread");
        stg_exit(EXIT_FAILURE);
    }
    return (exit_code == STILL_ACTIVE);
}

134 135 136 137 138 139
#ifdef USE_CRITICAL_SECTIONS
void
initMutex (Mutex* pMut)
{
    InitializeCriticalSectionAndSpinCount(pMut,4000);
}
140 141 142 143 144
void
closeMutex (Mutex* pMut)
{
    DeleteCriticalSection(pMut);
}
145
#else
sof's avatar
sof committed
146 147
void
initMutex (Mutex* pMut)
sof's avatar
sof committed
148
{
sof's avatar
sof committed
149 150 151 152 153
  HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
			   FALSE, /* not owned => initially signalled */
			   NULL
			   );
  *pMut = h;
sof's avatar
sof committed
154 155
  return;
}
156 157 158 159 160
void
closeMutex (Mutex* pMut)
{
    CloseHandle(*pMut);
}
161
#endif
sof's avatar
sof committed
162

163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
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);
179 180 181 182
#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) {
Simon Marlow's avatar
Simon Marlow committed
183 184
	sysErrorBelch("getThreadLocalVar");
        stg_exit(EXIT_FAILURE);
185
    }
186
#endif
187 188 189 190 191 192 193 194 195
    return r;
}

void
setThreadLocalVar (ThreadLocalKey *key, void *value)
{
    BOOL b;
    b = TlsSetValue(*key, value);
    if (!b) {
Simon Marlow's avatar
Simon Marlow committed
196 197
	sysErrorBelch("setThreadLocalVar");
        stg_exit(EXIT_FAILURE);
198 199 200
    }
}

201 202 203 204 205 206 207 208 209 210 211
void
freeThreadLocalKey (ThreadLocalKey *key)
{
    BOOL r;
    r = TlsFree(*key);
    if (r == 0) {
        DWORD dw = GetLastError();
	barf("freeThreadLocalKey failed: %lu", dw);
    }
}

212

213 214 215
static unsigned __stdcall
forkOS_createThreadWrapper ( void * entry )
{
216 217
    Capability *cap;
    cap = rts_lock();
218
    cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
219
    rts_unlock(cap);
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
    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);
}

235 236 237 238 239 240 241 242 243 244 245 246 247 248
nat
getNumberOfProcessors (void)
{
    static nat nproc = 0;

    if (nproc == 0) {
        SYSTEM_INFO si;
        GetSystemInfo(&si);
        nproc = si.dwNumberOfProcessors;
    }

    return nproc;
}

249
void
250
setThreadAffinity (nat n, nat m) // cap N of M
251
{
252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
    HANDLE hThread;
    DWORD_PTR mask, r;  // 64-bit win is required to handle more than 32 procs
    nat nproc, i;

    hThread = GetCurrentThread();

    nproc = getNumberOfProcessors();

    mask = 0;
    for (i = n; i < nproc; i+=m) {
        mask |= 1 << i;
    }

    r = SetThreadAffinityMask(hThread, mask);
    if (r == 0) {
	sysErrorBelch("SetThreadAffinity");
        stg_exit(EXIT_FAILURE);
    }
270 271
}

272
#else /* !defined(THREADED_RTS) */
273 274

int
275
forkOS_createThread ( HsStablePtr entry STG_UNUSED )
276 277 278 279
{
    return -1;
}

280
#endif /* !defined(THREADED_RTS) */