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     errorBelch("initCondition: unable to create");
  42   }
  43   *pCond = h;
  44   return;
  45 }
  46
  47 void
  48 closeCondition( Condition* pCond )
  49 {
  50   if ( CloseHandle(*pCond) == 0 ) {
  51     errorBelch("closeCondition: failed to close");
  52   }
  53   return;
  54 }
  55
  56 rtsBool
  57 broadcastCondition ( Condition* pCond )
  58 {
  59   PulseEvent(*pCond);
  60   return rtsTrue;
  61 }
  62
  63 rtsBool
  64 signalCondition ( Condition* pCond )
  65 {
  66     if (SetEvent(*pCond) == 0) {
  67         barf("SetEvent: %d", GetLastError());
  68     }
  69     return rtsTrue;
  70 }
  71
  72 rtsBool
  73 waitCondition ( Condition* pCond, Mutex* pMut )
  74 {
  75   RELEASE_LOCK(pMut);
  76   WaitForSingleObject(*pCond, INFINITE);
  77   /* Hmm..use WaitForMultipleObjects() ? */
  78   ACQUIRE_LOCK(pMut);
  79   return rtsTrue;
  80 }
  81
  82 void
  83 yieldThread()
  84 {
  85   Sleep(0);
  86   return;
  87 }
  88
  89 void
  90 shutdownThread()
  91 {
  92   _endthreadex(0);
  93 }
  94
  95 int
  96 createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
  97 {
  98
  99   return (_beginthreadex ( NULL,  /* default security attributes */
 100                            0,
 101                            (unsigned (__stdcall *)(void *)) startProc,
 102                            param,
 103                            0,
 104                            (unsigned*)pId) == 0);
 105 }
 106
 107 OSThreadId
 108 osThreadId()
 109 {
 110   return GetCurrentThreadId();
 111 }
 112
 113 #ifdef USE_CRITICAL_SECTIONS
 114 void
 115 initMutex (Mutex* pMut)
 116 {
 117     InitializeCriticalSectionAndSpinCount(pMut,4000);
 118 }
 119 void
 120 closeMutex (Mutex* pMut)
 121 {
 122     DeleteCriticalSection(pMut);
 123 }
 124 #else
 125 void
 126 initMutex (Mutex* pMut)
 127 {
 128   HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
 129                            FALSE, /* not owned => initially signalled */
 130                            NULL
 131                            );
 132   *pMut = h;
 133   return;
 134 }
 135 void
 136 closeMutex (Mutex* pMut)
 137 {
 138     CloseHandle(*pMut);
 139 }
 140 #endif
 141
 142 void
 143 newThreadLocalKey (ThreadLocalKey *key)
 144 {
 145     DWORD r;
 146     r = TlsAlloc();
 147     if (r == TLS_OUT_OF_INDEXES) {
 148         barf("newThreadLocalKey: out of keys");
 149     }
 150     *key = r;
 151 }
 152
 153 void *
 154 getThreadLocalVar (ThreadLocalKey *key)
 155 {
 156     void *r;
 157     r = TlsGetValue(*key);
 158 #ifdef DEBUG
 159     // r is allowed to be NULL - it can mean that either there was an
 160     // error or the stored value is in fact NULL.
 161     if (GetLastError() != NO_ERROR) {
 162         barf("getThreadLocalVar: key not found");
 163     }
 164 #endif
 165     return r;
 166 }
 167
 168 void
 169 setThreadLocalVar (ThreadLocalKey *key, void *value)
 170 {
 171     BOOL b;
 172     b = TlsSetValue(*key, value);
 173     if (!b) {
 174         barf("setThreadLocalVar: %d", GetLastError());
 175     }
 176 }
 177
 178
 179 static unsigned __stdcall
 180 forkOS_createThreadWrapper ( void * entry )
 181 {
 182     Capability *cap;
 183     cap = rts_lock();
 184     cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
 185     rts_unlock(cap);
 186     return 0;
 187 }
 188
 189 int
 190 forkOS_createThread ( HsStablePtr entry )
 191 {
 192     unsigned long pId;
 193     return (_beginthreadex ( NULL,  /* default security attributes */
 194                            0,
 195                            forkOS_createThreadWrapper,
 196                            (void*)entry,
 197                            0,
 198                            (unsigned*)&pId) == 0);
 199 }
 200
 201 #else /* !defined(THREADED_RTS) */
 202
 203 int
 204 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
 205 {
 206     return -1;
 207 }
 208
 209 #endif /* !defined(THREADED_RTS) */