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 | |
---|