win32/win32thread.c

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3
   4 #ifdef USE_DECLSPEC_THREAD
   5 __declspec(thread) struct perl_thread *Perl_current_thread = NULL;
   6 #endif
   7
   8 void
   9 Perl_setTHR(struct perl_thread *t)
  10 {
  11 #ifdef USE_THREADS
  12 #ifdef USE_DECLSPEC_THREAD
  13  Perl_current_thread = t;
  14 #else
  15  TlsSetValue(thr_key,t);
  16 #endif
  17 #endif
  18 }
  19
  20 struct perl_thread *
  21 Perl_getTHR(void)
  22 {
  23 #ifdef USE_THREADS
  24 #ifdef USE_DECLSPEC_THREAD
  25  return Perl_current_thread;
  26 #else
  27  return (struct perl_thread *) TlsGetValue(thr_key);
  28 #endif
  29 #else
  30  return NULL;
  31 #endif
  32 }
  33
  34 void
  35 Perl_alloc_thread_key(void)
  36 {
  37 #ifdef USE_THREADS
  38     static int key_allocated = 0;
  39     if (!key_allocated) {
  40         if ((thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES)
  41             croak("panic: TlsAlloc");
  42         key_allocated = 1;
  43     }
  44 #endif
  45 }
  46
  47 void
  48 Perl_init_thread_intern(struct perl_thread *athr)
  49 {
  50 #ifdef USE_THREADS
  51 #ifndef USE_DECLSPEC_THREAD
  52
  53  /*
  54   * Initialize port-specific per-thread data in thr->i
  55   * as only things we have there are just static areas for
  56   * return values we don't _need_ to do anything but
  57   * this is good practice:
  58   */
  59  memset(&athr->i,0,sizeof(athr->i));
  60
  61 #endif
  62 #endif
  63 }
  64
  65 void
  66 Perl_set_thread_self(struct perl_thread *thr)
  67 {
  68 #ifdef USE_THREADS
  69     /* Set thr->self.  GetCurrentThread() retrurns a pseudo handle, need
  70        this to convert it into a handle another thread can use.
  71      */
  72     DuplicateHandle(GetCurrentProcess(),
  73                     GetCurrentThread(),
  74                     GetCurrentProcess(),
  75                     &thr->self,
  76                     0,
  77                     FALSE,
  78                     DUPLICATE_SAME_ACCESS);
  79 #endif
  80 }
  81
  82 #ifdef USE_THREADS
  83 int
  84 Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
  85 {
  86     DWORD junk;
  87     unsigned long th;
  88
  89     MUTEX_LOCK(&thr->mutex);
  90     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
  91                           "%p: create OS thread\n", thr));
  92 #ifdef USE_RTL_THREAD_API
  93     /* See comment about USE_RTL_THREAD_API in win32thread.h */
  94 #if defined(__BORLANDC__)
  95     th = _beginthreadNT(fn,                             /* start address */
  96                         0,                              /* stack size */
  97                         (void *)thr,                    /* parameters */
  98                         (void *)NULL,                   /* security attrib */
  99                         0,                              /* creation flags */
 100                         (unsigned long *)&junk);        /* tid */
 101     if (th == (unsigned long)-1)
 102         th = 0;
 103 #elif defined(_MSC_VER_)
 104     th = _beginthreadex((void *)NULL,                   /* security attrib */
 105                         0,                              /* stack size */
 106                         fn,                             /* start address */
 107                         (void*)thr,                     /* parameters */
 108                         0,                              /* creation flags */
 109                         (unsigned *)&junk);             /* tid */
 110 #else /* compilers using CRTDLL.DLL only have _beginthread() */
 111     th = _beginthread(fn,                               /* start address */
 112                       0,                                /* stack size */
 113                       (void*)thr);                      /* parameters */
 114     if (th == (unsigned long)-1)
 115         th = 0;
 116 #endif
 117     thr->self = (HANDLE)th;
 118 #else   /* !USE_RTL_THREAD_API */
 119     thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
 120 #endif  /* !USE_RTL_THREAD_API */
 121     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 122                           "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
 123     MUTEX_UNLOCK(&thr->mutex);
 124     return thr->self ? 0 : -1;
 125 }
 126 #endif
 127