This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ignore const for the purposes of typemaps (from Hugo van der Sanden)
[perl5.git] / win32 / win32thread.c
CommitLineData
ea0efc06
MB
1#include "EXTERN.h"
2#include "perl.h"
d55594ae 3
c69f6586
GS
4#if defined(PERL_OBJECT)
5#define NO_XSLOCKS
6extern CPerlObj* pPerl;
7#include "XSUB.h"
8#endif
9
c69f112c 10#ifdef USE_DECLSPEC_THREAD
ba869deb 11__declspec(thread) void *PL_current_context = NULL;
c69f112c 12#endif
9811a7d7
NIS
13
14void
ba869deb 15Perl_set_context(void *t)
9811a7d7 16{
ba869deb
GS
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
4c36ecb7 25#endif
9811a7d7
NIS
26}
27
ba869deb
GS
28void *
29Perl_get_context(void)
9811a7d7 30{
ba869deb
GS
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
4c36ecb7 40#else
ba869deb 41 return NULL;
4c36ecb7 42#endif
9811a7d7
NIS
43}
44
d55594ae 45#ifdef USE_THREADS
ea0efc06 46void
22239a37 47Perl_init_thread_intern(struct perl_thread *athr)
c53bd28a 48{
c53bd28a
NIS
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 */
22239a37 57 memset(&athr->i,0,sizeof(athr->i));
c53bd28a
NIS
58
59#endif
c53bd28a
NIS
60}
61
62void
52e1cb5e 63Perl_set_thread_self(struct perl_thread *thr)
ea0efc06 64{
4b026b9e
GS
65 /* Set thr->self. GetCurrentThread() retrurns a pseudo handle, need
66 this to convert it into a handle another thread can use.
d55594ae 67 */
ea0efc06
MB
68 DuplicateHandle(GetCurrentProcess(),
69 GetCurrentThread(),
70 GetCurrentProcess(),
46930d8f 71 &thr->self,
ea0efc06
MB
72 0,
73 FALSE,
74 DUPLICATE_SAME_ACCESS);
ea0efc06
MB
75}
76
77int
52e1cb5e 78Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
ea0efc06
MB
79{
80 DWORD junk;
2d7a9237 81 unsigned long th;
ea0efc06 82
bf49b057 83 DEBUG_S(PerlIO_printf(Perl_debug_log,
d55594ae 84 "%p: create OS thread\n", thr));
2d7a9237
GS
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 */
46930d8f 112 thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk);
2d7a9237 113#endif /* !USE_RTL_THREAD_API */
bf49b057 114 DEBUG_S(PerlIO_printf(Perl_debug_log,
d55594ae 115 "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
46930d8f 116 return thr->self ? 0 : -1;
ea0efc06 117}
d55594ae 118#endif
22239a37 119