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 #if defined(THREADED_RTS)
  12 #include "OSThreads.h"
  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   Sleep(0);
  88   return;
  89 }
  90
  91 void
  92 shutdownThread()
  93 {
  94   _endthreadex(0);
  95 }
  96
  97 int
  98 createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
  99 {
 100
 101   return (_beginthreadex ( NULL,  /* default security attributes */
 102                            0,
 103                            (unsigned (__stdcall *)(void *)) startProc,
 104                            param,
 105                            0,
 106                            (unsigned*)pId) == 0);
 107 }
 108
 109 OSThreadId
 110 osThreadId()
 111 {
 112   return GetCurrentThreadId();
 113 }
 114
 115 #ifdef USE_CRITICAL_SECTIONS
 116 void
 117 initMutex (Mutex* pMut)
 118 {
 119     InitializeCriticalSectionAndSpinCount(pMut,4000);
 120 }
 121 void
 122 closeMutex (Mutex* pMut)
 123 {
 124     DeleteCriticalSection(pMut);
 125 }
 126 #else
 127 void
 128 initMutex (Mutex* pMut)
 129 {
 130   HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
 131                            FALSE, /* not owned => initially signalled */
 132                            NULL
 133                            );
 134   *pMut = h;
 135   return;
 136 }
 137 void
 138 closeMutex (Mutex* pMut)
 139 {
 140     CloseHandle(*pMut);
 141 }
 142 #endif
 143
 144 void
 145 newThreadLocalKey (ThreadLocalKey *key)
 146 {
 147     DWORD r;
 148     r = TlsAlloc();
 149     if (r == TLS_OUT_OF_INDEXES) {
 150         barf("newThreadLocalKey: out of keys");
 151     }
 152     *key = r;
 153 }
 154
 155 void *
 156 getThreadLocalVar (ThreadLocalKey *key)
 157 {
 158     void *r;
 159     r = TlsGetValue(*key);
 160 #ifdef DEBUG
 161     // r is allowed to be NULL - it can mean that either there was an
 162     // error or the stored value is in fact NULL.
 163     if (GetLastError() != NO_ERROR) {
 164         barf("getThreadLocalVar: key not found");
 165     }
 166 #endif
 167     return r;
 168 }
 169
 170 void
 171 setThreadLocalVar (ThreadLocalKey *key, void *value)
 172 {
 173     BOOL b;
 174     b = TlsSetValue(*key, value);
 175     if (!b) {
 176         barf("setThreadLocalVar: %d", GetLastError());
 177     }
 178 }
 179
 180
 181 static unsigned __stdcall
 182 forkOS_createThreadWrapper ( void * entry )
 183 {
 184     Capability *cap;
 185     cap = rts_lock();
 186     cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
 187     rts_unlock(cap);
 188     return 0;
 189 }
 190
 191 int
 192 forkOS_createThread ( HsStablePtr entry )
 193 {
 194     unsigned long pId;
 195     return (_beginthreadex ( NULL,  /* default security attributes */
 196                            0,
 197                            forkOS_createThreadWrapper,
 198                            (void*)entry,
 199                            0,
 200                            (unsigned*)&pId) == 0);
 201 }
 202
 203 #else /* !defined(THREADED_RTS) */
 204
 205 int
 206 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
 207 {
 208     return -1;
 209 }
 210
 211 #endif /* !defined(THREADED_RTS) */