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