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 #else
 120 void
 121 initMutex (Mutex* pMut)
 122 {
 123   HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
 124                            FALSE, /* not owned => initially signalled */
 125                            NULL
 126                            );
 127   *pMut = h;
 128   return;
 129 }
 130 #endif
 131
 132 void
 133 newThreadLocalKey (ThreadLocalKey *key)
 134 {
 135     DWORD r;
 136     r = TlsAlloc();
 137     if (r == TLS_OUT_OF_INDEXES) {
 138         barf("newThreadLocalKey: out of keys");
 139     }
 140     *key = r;
 141 }
 142
 143 void *
 144 getThreadLocalVar (ThreadLocalKey *key)
 145 {
 146     void *r;
 147     r = TlsGetValue(*key);
 148 #ifdef DEBUG
 149     // r is allowed to be NULL - it can mean that either there was an
 150     // error or the stored value is in fact NULL.
 151     if (GetLastError() != NO_ERROR) {
 152         barf("getThreadLocalVar: key not found");
 153     }
 154 #endif
 155     return r;
 156 }
 157
 158 void
 159 setThreadLocalVar (ThreadLocalKey *key, void *value)
 160 {
 161     BOOL b;
 162     b = TlsSetValue(*key, value);
 163     if (!b) {
 164         barf("setThreadLocalVar: %d", GetLastError());
 165     }
 166 }
 167
 168
 169 static unsigned __stdcall
 170 forkOS_createThreadWrapper ( void * entry )
 171 {
 172     Capability *cap;
 173     cap = rts_lock();
 174     cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
 175     rts_unlock(cap);
 176     return 0;
 177 }
 178
 179 int
 180 forkOS_createThread ( HsStablePtr entry )
 181 {
 182     unsigned long pId;
 183     return (_beginthreadex ( NULL,  /* default security attributes */
 184                            0,
 185                            forkOS_createThreadWrapper,
 186                            (void*)entry,
 187                            0,
 188                            (unsigned*)&pId) == 0);
 189 }
 190
 191 #else /* !defined(THREADED_RTS) */
 192
 193 int
 194 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
 195 {
 196     return -1;
 197 }
 198
 199 #endif /* !defined(THREADED_RTS) */