This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Non-threaded build fix
[perl5.git] / win32 / win32thread.c
CommitLineData
ea0efc06
MB
1#include "EXTERN.h"
2#include "perl.h"
d55594ae 3
c69f112c 4#ifdef USE_DECLSPEC_THREAD
61c8b479 5__declspec(thread) struct perl_thread *Perl_current_thread = NULL;
c69f112c 6#endif
9811a7d7
NIS
7
8void
61c8b479 9Perl_setTHR(struct perl_thread *t)
9811a7d7 10{
4c36ecb7 11#ifdef USE_THREADS
c69f112c 12#ifdef USE_DECLSPEC_THREAD
0fefa03b 13 Perl_current_thread = t;
c69f112c
NIS
14#else
15 TlsSetValue(thr_key,t);
16#endif
4c36ecb7 17#endif
9811a7d7
NIS
18}
19
61c8b479 20struct perl_thread *
9811a7d7
NIS
21Perl_getTHR(void)
22{
4c36ecb7 23#ifdef USE_THREADS
c69f112c 24#ifdef USE_DECLSPEC_THREAD
0fefa03b 25 return Perl_current_thread;
c69f112c
NIS
26#else
27 return (struct perl_thread *) TlsGetValue(thr_key);
28#endif
4c36ecb7
NIS
29#else
30 return NULL;
31#endif
9811a7d7
NIS
32}
33
d55594ae
GS
34void
35Perl_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}
ea0efc06
MB
46
47void
52e1cb5e 48Perl_set_thread_self(struct perl_thread *thr)
ea0efc06 49{
d55594ae 50#ifdef USE_THREADS
4b026b9e
GS
51 /* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need
52 this to convert it into a handle another thread can use.
d55594ae 53 */
ea0efc06
MB
54 DuplicateHandle(GetCurrentProcess(),
55 GetCurrentThread(),
56 GetCurrentProcess(),
46930d8f 57 &thr->self,
ea0efc06
MB
58 0,
59 FALSE,
60 DUPLICATE_SAME_ACCESS);
d55594ae 61#endif
ea0efc06
MB
62}
63
d55594ae 64#ifdef USE_THREADS
ea0efc06 65int
52e1cb5e 66Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
ea0efc06
MB
67{
68 DWORD junk;
69
70 MUTEX_LOCK(&thr->mutex);
d55594ae
GS
71 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
72 "%p: create OS thread\n", thr));
46930d8f 73 thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
d55594ae
GS
74 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
75 "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
ea0efc06 76 MUTEX_UNLOCK(&thr->mutex);
46930d8f 77 return thr->self ? 0 : -1;
ea0efc06 78}
d55594ae 79#endif