ghc/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                            startProc,
 102                            param,
 103                            0,
 104                            (unsigned*)pId) == 0);
 105 }
 106
 107 OSThreadId
 108 osThreadId()
 109 {
 110   return GetCurrentThreadId();
 111 }
 112
 113 void
 114 initMutex (Mutex* pMut)
 115 {
 116   HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
 117                            FALSE, /* not owned => initially signalled */
 118                            NULL
 119                            );
 120   *pMut = h;
 121   return;
 122 }
 123
 124 void
 125 newThreadLocalKey (ThreadLocalKey *key)
 126 {
 127     DWORD r;
 128     r = TlsAlloc();
 129     if (r == TLS_OUT_OF_INDEXES) {
 130         barf("newThreadLocalKey: out of keys");
 131     }
 132     *key = r;
 133 }
 134
 135 void *
 136 getThreadLocalVar (ThreadLocalKey *key)
 137 {
 138     void *r;
 139     r = TlsGetValue(*key);
 140     if (r == NULL) {
 141         barf("getThreadLocalVar: key not found");
 142     }
 143     return r;
 144 }
 145
 146 void
 147 setThreadLocalVar (ThreadLocalKey *key, void *value)
 148 {
 149     BOOL b;
 150     b = TlsSetValue(*key, value);
 151     if (!b) {
 152         barf("setThreadLocalVar: %d", GetLastError());
 153     }
 154 }
 155
 156
 157 static unsigned __stdcall
 158 forkOS_createThreadWrapper ( void * entry )
 159 {
 160     Capability *cap;
 161     cap = rts_lock();
 162     rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
 163     rts_unlock(cap);
 164     return 0;
 165 }
 166
 167 int
 168 forkOS_createThread ( HsStablePtr entry )
 169 {
 170     unsigned long pId;
 171     return (_beginthreadex ( NULL,  /* default security attributes */
 172                            0,
 173                            forkOS_createThreadWrapper,
 174                            (void*)entry,
 175                            0,
 176                            (unsigned*)&pId) == 0);
 177 }
 178
 179 #else /* !defined(THREADED_RTS) */
 180
 181 int
 182 forkOS_createThread ( HsStablePtr entry STG_UNUSED )
 183 {
 184     return -1;
 185 }
 186
 187 #endif /* !defined(THREADED_RTS) */