This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[asperl] added AS patch#8
[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
22239a37 48Perl_init_thread_intern(struct perl_thread *athr)
c53bd28a
NIS
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 */
22239a37 59 memset(&athr->i,0,sizeof(athr->i));
c53bd28a
NIS
60
61#endif
62#endif
63}
64
65void
52e1cb5e 66Perl_set_thread_self(struct perl_thread *thr)
ea0efc06 67{
d55594ae 68#ifdef USE_THREADS
4b026b9e
GS
69 /* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need
70 this to convert it into a handle another thread can use.
d55594ae 71 */
ea0efc06
MB
72 DuplicateHandle(GetCurrentProcess(),
73 GetCurrentThread(),
74 GetCurrentProcess(),
46930d8f 75 &thr->self,
ea0efc06
MB
76 0,
77 FALSE,
78 DUPLICATE_SAME_ACCESS);
d55594ae 79#endif
ea0efc06
MB
80}
81
d55594ae 82#ifdef USE_THREADS
ea0efc06 83int
52e1cb5e 84Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
ea0efc06
MB
85{
86 DWORD junk;
2d7a9237 87 unsigned long th;
ea0efc06
MB
88
89 MUTEX_LOCK(&thr->mutex);
d55594ae
GS
90 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
91 "%p: create OS thread\n", thr));
2d7a9237
GS
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 */
46930d8f 119 thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
2d7a9237 120#endif /* !USE_RTL_THREAD_API */
d55594ae
GS
121 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
122 "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
ea0efc06 123 MUTEX_UNLOCK(&thr->mutex);
46930d8f 124 return thr->self ? 0 : -1;
ea0efc06 125}
d55594ae 126#endif
22239a37 127