Commit | Line | Data |
---|---|---|
47ba8780 AB |
1 | #include "threads.h" |
2 | ||
47ba8780 | 3 | /* |
b1edfb69 JH |
4 | * Starts executing the thread. Needs to clean up memory a tad better. |
5 | */ | |
47ba8780 AB |
6 | |
7 | #ifdef WIN32 | |
e6e315b9 | 8 | THREAD_RET_TYPE Perl_thread_run(LPVOID arg) { |
47ba8780 | 9 | #else |
e8f2bb9a | 10 | void* Perl_thread_run(void * arg) { |
47ba8780 | 11 | #endif |
5b414d21 | 12 | ithread* thread = (ithread*) arg; |
47ba8780 AB |
13 | SV* thread_tid_ptr; |
14 | SV* thread_ptr; | |
15 | dTHXa(thread->interp); | |
47ba8780 AB |
16 | PERL_SET_CONTEXT(thread->interp); |
17 | ||
18 | #ifdef WIN32 | |
19 | thread->thr = GetCurrentThreadId(); | |
20 | #else | |
21 | thread->thr = pthread_self(); | |
22 | #endif | |
23 | ||
4f896ddc | 24 | SHAREDSvLOCK(threads); |
47ba8780 | 25 | SHAREDSvEDIT(threads); |
7f9a95ef AB |
26 | PERL_THREAD_SETSPECIFIC(self_key,INT2PTR(void*,thread->tid)); |
27 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, thread->tid); | |
b1edfb69 | 28 | thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread)); |
47ba8780 AB |
29 | hv_store_ent((HV*)SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0); |
30 | SvREFCNT_dec(thread_tid_ptr); | |
31 | SHAREDSvRELEASE(threads); | |
4f896ddc | 32 | SHAREDSvUNLOCK(threads); |
47ba8780 | 33 | PL_perl_destruct_level = 2; |
4f896ddc | 34 | |
47ba8780 AB |
35 | { |
36 | ||
37 | AV* params; | |
38 | I32 len; | |
39 | int i; | |
40 | dSP; | |
41 | params = (AV*) SvRV(thread->params); | |
42 | len = av_len(params); | |
43 | ENTER; | |
44 | SAVETMPS; | |
45 | PUSHMARK(SP); | |
46 | if(len > -1) { | |
47 | for(i = 0; i < len + 1; i++) { | |
48 | XPUSHs(av_shift(params)); | |
49 | } | |
50 | } | |
51 | PUTBACK; | |
4f896ddc | 52 | call_sv(thread->init_function, G_DISCARD); |
47ba8780 AB |
53 | FREETMPS; |
54 | LEAVE; | |
55 | ||
56 | ||
57 | } | |
58 | ||
47ba8780 | 59 | MUTEX_LOCK(&thread->mutex); |
fd58862f | 60 | PerlIO_flush((PerlIO*)NULL); |
47ba8780 AB |
61 | perl_destruct(thread->interp); |
62 | perl_free(thread->interp); | |
63 | if(thread->detached == 1) { | |
64 | MUTEX_UNLOCK(&thread->mutex); | |
e6e315b9 | 65 | Perl_thread_destruct(thread); |
47ba8780 AB |
66 | } else { |
67 | MUTEX_UNLOCK(&thread->mutex); | |
68 | } | |
69 | #ifdef WIN32 | |
70 | return (DWORD)0; | |
e8f2bb9a JH |
71 | #else |
72 | return 0; | |
47ba8780 AB |
73 | #endif |
74 | ||
75 | } | |
76 | ||
47ba8780 | 77 | /* |
b1edfb69 JH |
78 | * iThread->create(); |
79 | */ | |
47ba8780 | 80 | |
e6e315b9 | 81 | SV* Perl_thread_create(char* class, SV* init_function, SV* params) { |
47ba8780 AB |
82 | ithread* thread = malloc(sizeof(ithread)); |
83 | SV* obj_ref; | |
84 | SV* obj; | |
85 | SV* temp_store; | |
47ba8780 | 86 | PerlInterpreter *current_perl; |
b50cb5ff | 87 | CLONE_PARAMS clone_param; |
47ba8780 AB |
88 | |
89 | MUTEX_LOCK(&create_mutex); | |
90 | obj_ref = newSViv(0); | |
91 | obj = newSVrv(obj_ref, class); | |
170958c3 | 92 | sv_setiv(obj, PTR2IV(thread)); |
b1edfb69 | 93 | SvREADONLY_on(obj); |
b6a0b930 | 94 | PerlIO_flush((PerlIO*)NULL); |
b1edfb69 | 95 | current_perl = PERL_GET_CONTEXT; |
47ba8780 | 96 | |
4f896ddc | 97 | |
47ba8780 | 98 | |
cd8c9bf8 | 99 | temp_store = Perl_get_sv(current_perl, "threads::origthread", TRUE | GV_ADDMULTI); |
170958c3 | 100 | sv_setiv(temp_store,PTR2IV(current_perl)); |
cd8c9bf8 AB |
101 | temp_store = NULL; |
102 | ||
103 | ||
47ba8780 | 104 | #ifdef WIN32 |
b50cb5ff | 105 | thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST); |
47ba8780 | 106 | #else |
b50cb5ff | 107 | thread->interp = perl_clone(current_perl, CLONEf_KEEP_PTR_TABLE); |
47ba8780 | 108 | #endif |
b50cb5ff | 109 | |
47ba8780 | 110 | |
b50cb5ff AB |
111 | clone_param.flags = 0; |
112 | thread->init_function = Perl_sv_dup(thread->interp, init_function, &clone_param); | |
113 | if(SvREFCNT(thread->init_function) == 0) { | |
114 | SvREFCNT_inc(thread->init_function); | |
115 | } | |
116 | ||
117 | thread->params = Perl_sv_dup(thread->interp,params, &clone_param); | |
118 | SvREFCNT_inc(thread->params); | |
119 | SvTEMP_off(thread->init_function); | |
120 | ptr_table_free(PL_ptr_table); | |
121 | PL_ptr_table = NULL; | |
122 | ||
47ba8780 | 123 | |
47ba8780 | 124 | |
47ba8780 AB |
125 | |
126 | PERL_SET_CONTEXT(current_perl); | |
127 | ||
47ba8780 | 128 | |
b1edfb69 | 129 | /* let's init the thread */ |
47ba8780 AB |
130 | |
131 | MUTEX_INIT(&thread->mutex); | |
132 | thread->tid = tid_counter++; | |
133 | thread->detached = 0; | |
134 | thread->count = 1; | |
135 | ||
136 | #ifdef WIN32 | |
137 | ||
e6e315b9 | 138 | thread->handle = CreateThread(NULL, 0, Perl_thread_run, |
47ba8780 AB |
139 | (LPVOID)thread, 0, &thread->thr); |
140 | ||
82c40bf6 AB |
141 | |
142 | #else | |
fa26028c AB |
143 | { |
144 | static pthread_attr_t attr; | |
145 | static int attr_inited = 0; | |
146 | sigset_t fullmask, oldmask; | |
147 | static int attr_joinable = PTHREAD_CREATE_JOINABLE; | |
148 | if (!attr_inited) { | |
149 | attr_inited = 1; | |
150 | pthread_attr_init(&attr); | |
151 | } | |
152 | # ifdef PTHREAD_ATTR_SETDETACHSTATE | |
153 | PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); | |
154 | # endif | |
3eb37d38 AB |
155 | # ifdef THREAD_CREATE_NEEDS_STACK |
156 | if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK)) | |
157 | croak("panic: pthread_attr_setstacksize failed"); | |
158 | # endif | |
159 | ||
3ad0b7d6 | 160 | #ifdef OLD_PTHREADS_API |
fa26028c | 161 | pthread_create( &thread->thr, attr, Perl_thread_run, (void *)thread); |
47ba8780 | 162 | #else |
3ad0b7d6 | 163 | pthread_create( &thread->thr, &attr, Perl_thread_run, (void *)thread); |
47ba8780 | 164 | #endif |
3ad0b7d6 | 165 | } |
82c40bf6 | 166 | #endif |
47ba8780 AB |
167 | MUTEX_UNLOCK(&create_mutex); |
168 | ||
b1edfb69 | 169 | return obj_ref; |
47ba8780 AB |
170 | } |
171 | ||
172 | /* | |
b1edfb69 JH |
173 | * returns the id of the thread |
174 | */ | |
e6e315b9 | 175 | I32 Perl_thread_tid (SV* obj) { |
47ba8780 AB |
176 | ithread* thread; |
177 | if(!SvROK(obj)) { | |
e6e315b9 | 178 | obj = Perl_thread_self(SvPV_nolen(obj)); |
170958c3 | 179 | thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 AB |
180 | SvREFCNT_dec(obj); |
181 | } else { | |
170958c3 | 182 | thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 AB |
183 | } |
184 | return thread->tid; | |
185 | } | |
186 | ||
e6e315b9 | 187 | SV* Perl_thread_self (char* class) { |
47ba8780 AB |
188 | dTHX; |
189 | SV* obj_ref; | |
190 | SV* obj; | |
b1edfb69 JH |
191 | SV* thread_tid_ptr; |
192 | SV* thread_ptr; | |
193 | HE* thread_entry; | |
7f9a95ef AB |
194 | void* id; |
195 | PERL_THREAD_GETSPECIFIC(self_key,id); | |
4f896ddc | 196 | SHAREDSvLOCK(threads); |
47ba8780 | 197 | SHAREDSvEDIT(threads); |
7f9a95ef AB |
198 | |
199 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(id)); | |
82c40bf6 | 200 | |
b1edfb69 JH |
201 | thread_entry = Perl_hv_fetch_ent(PL_sharedsv_space, |
202 | (HV*) SHAREDSvGET(threads), | |
203 | thread_tid_ptr, 0,0); | |
47ba8780 AB |
204 | thread_ptr = HeVAL(thread_entry); |
205 | SvREFCNT_dec(thread_tid_ptr); | |
47ba8780 | 206 | SHAREDSvRELEASE(threads); |
4f896ddc | 207 | SHAREDSvUNLOCK(threads); |
47ba8780 AB |
208 | |
209 | obj_ref = newSViv(0); | |
210 | obj = newSVrv(obj_ref, class); | |
4f896ddc | 211 | sv_setsv(obj, thread_ptr); |
47ba8780 AB |
212 | SvREADONLY_on(obj); |
213 | return obj_ref; | |
214 | } | |
215 | ||
216 | /* | |
b1edfb69 JH |
217 | * joins the thread this code needs to take the returnvalue from the |
218 | * call_sv and send it back */ | |
47ba8780 | 219 | |
e6e315b9 | 220 | void Perl_thread_join(SV* obj) { |
170958c3 | 221 | ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 AB |
222 | #ifdef WIN32 |
223 | DWORD waitcode; | |
224 | waitcode = WaitForSingleObject(thread->handle, INFINITE); | |
225 | #else | |
226 | void *retval; | |
227 | pthread_join(thread->thr,&retval); | |
228 | #endif | |
229 | } | |
230 | ||
b1edfb69 JH |
231 | /* detaches a thread |
232 | * needs to better clean up memory */ | |
47ba8780 | 233 | |
e6e315b9 | 234 | void Perl_thread_detach(SV* obj) { |
170958c3 | 235 | ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 AB |
236 | MUTEX_LOCK(&thread->mutex); |
237 | thread->detached = 1; | |
82c40bf6 | 238 | PERL_THREAD_DETACH(thread->thr); |
47ba8780 AB |
239 | MUTEX_UNLOCK(&thread->mutex); |
240 | } | |
241 | ||
e6e315b9 | 242 | void Perl_thread_DESTROY (SV* obj) { |
170958c3 | 243 | ithread* thread = INT2PTR(ithread*, SvIV(SvRV(obj))); |
47ba8780 AB |
244 | |
245 | MUTEX_LOCK(&thread->mutex); | |
246 | thread->count--; | |
247 | MUTEX_UNLOCK(&thread->mutex); | |
e6e315b9 | 248 | Perl_thread_destruct(thread); |
47ba8780 AB |
249 | } |
250 | ||
e6e315b9 | 251 | void Perl_thread_destruct (ithread* thread) { |
47ba8780 AB |
252 | return; |
253 | MUTEX_LOCK(&thread->mutex); | |
254 | if(thread->count != 0) { | |
255 | MUTEX_UNLOCK(&thread->mutex); | |
256 | return; | |
257 | } | |
258 | MUTEX_UNLOCK(&thread->mutex); | |
259 | /* it is safe noone is holding a ref to this */ | |
260 | /*printf("proper destruction!\n");*/ | |
261 | } | |
262 | ||
47ba8780 AB |
263 | MODULE = threads PACKAGE = threads |
264 | BOOT: | |
265 | Perl_sharedsv_init(aTHX); | |
89e0305a | 266 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
47ba8780 AB |
267 | PL_perl_destruct_level = 2; |
268 | threads = Perl_sharedsv_new(aTHX); | |
269 | SHAREDSvEDIT(threads); | |
e8f2bb9a | 270 | SHAREDSvGET(threads) = (SV *)newHV(); |
47ba8780 AB |
271 | SHAREDSvRELEASE(threads); |
272 | { | |
273 | ||
274 | ||
275 | SV* temp = get_sv("threads::sharedsv_space", TRUE | GV_ADDMULTI); | |
170958c3 | 276 | SV* temp2 = newSViv(PTR2IV(PL_sharedsv_space)); |
47ba8780 AB |
277 | sv_setsv( temp , temp2 ); |
278 | } | |
279 | { | |
280 | ithread* thread = malloc(sizeof(ithread)); | |
281 | SV* thread_tid_ptr; | |
282 | SV* thread_ptr; | |
283 | MUTEX_INIT(&thread->mutex); | |
284 | thread->tid = 0; | |
285 | #ifdef WIN32 | |
286 | thread->thr = GetCurrentThreadId(); | |
287 | #else | |
288 | thread->thr = pthread_self(); | |
289 | #endif | |
d5ecd109 | 290 | SHAREDSvEDIT(threads); |
82c40bf6 | 291 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
7f9a95ef AB |
292 | PERL_THREAD_SETSPECIFIC(self_key,0); |
293 | thread_tid_ptr = Perl_newSVuv(PL_sharedsv_space, 0); | |
b1edfb69 | 294 | thread_ptr = Perl_newSVuv(PL_sharedsv_space, PTR2UV(thread)); |
47ba8780 | 295 | hv_store_ent((HV*) SHAREDSvGET(threads), thread_tid_ptr, thread_ptr,0); |
4f896ddc | 296 | SvREFCNT_dec(thread_tid_ptr); |
d5ecd109 | 297 | SHAREDSvRELEASE(threads); |
47ba8780 AB |
298 | } |
299 | MUTEX_INIT(&create_mutex); | |
300 | ||
47ba8780 AB |
301 | PROTOTYPES: DISABLE |
302 | ||
303 | SV * | |
304 | create (class, function_to_call, ...) | |
305 | char * class | |
306 | SV * function_to_call | |
307 | CODE: | |
308 | AV* params = newAV(); | |
309 | if(items > 2) { | |
310 | int i; | |
311 | for(i = 2; i < items ; i++) { | |
312 | av_push(params, ST(i)); | |
313 | } | |
314 | } | |
e6e315b9 | 315 | RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params)); |
47ba8780 AB |
316 | OUTPUT: |
317 | RETVAL | |
318 | ||
319 | SV * | |
8222d950 AB |
320 | new (class, function_to_call, ...) |
321 | char * class | |
322 | SV * function_to_call | |
323 | CODE: | |
324 | AV* params = newAV(); | |
325 | if(items > 2) { | |
326 | int i; | |
327 | for(i = 2; i < items ; i++) { | |
328 | av_push(params, ST(i)); | |
329 | } | |
330 | } | |
331 | RETVAL = Perl_thread_create(class, function_to_call, newRV_noinc((SV*) params)); | |
332 | OUTPUT: | |
333 | RETVAL | |
334 | ||
335 | ||
336 | ||
337 | SV * | |
47ba8780 AB |
338 | self (class) |
339 | char* class | |
340 | CODE: | |
e6e315b9 | 341 | RETVAL = Perl_thread_self(class); |
47ba8780 AB |
342 | OUTPUT: |
343 | RETVAL | |
344 | ||
345 | int | |
346 | tid (obj) | |
347 | SV * obj; | |
348 | CODE: | |
e6e315b9 | 349 | RETVAL = Perl_thread_tid(obj); |
47ba8780 AB |
350 | OUTPUT: |
351 | RETVAL | |
352 | ||
353 | void | |
354 | join (obj) | |
355 | SV * obj | |
356 | PREINIT: | |
357 | I32* temp; | |
358 | PPCODE: | |
359 | temp = PL_markstack_ptr++; | |
e6e315b9 | 360 | Perl_thread_join(obj); |
47ba8780 AB |
361 | if (PL_markstack_ptr != temp) { |
362 | /* truly void, because dXSARGS not invoked */ | |
363 | PL_markstack_ptr = temp; | |
364 | XSRETURN_EMPTY; /* return empty stack */ | |
365 | } | |
366 | /* must have used dXSARGS; list context implied */ | |
367 | return; /* assume stack size is correct */ | |
368 | ||
369 | void | |
370 | detach (obj) | |
371 | SV * obj | |
372 | PREINIT: | |
373 | I32* temp; | |
374 | PPCODE: | |
375 | temp = PL_markstack_ptr++; | |
e6e315b9 | 376 | Perl_thread_detach(obj); |
47ba8780 AB |
377 | if (PL_markstack_ptr != temp) { |
378 | /* truly void, because dXSARGS not invoked */ | |
379 | PL_markstack_ptr = temp; | |
380 | XSRETURN_EMPTY; /* return empty stack */ | |
381 | } | |
382 | /* must have used dXSARGS; list context implied */ | |
383 | return; /* assume stack size is correct */ | |
384 | ||
47ba8780 AB |
385 | void |
386 | DESTROY (obj) | |
387 | SV * obj | |
388 | PREINIT: | |
389 | I32* temp; | |
390 | PPCODE: | |
391 | temp = PL_markstack_ptr++; | |
e6e315b9 | 392 | Perl_thread_DESTROY(obj); |
47ba8780 AB |
393 | if (PL_markstack_ptr != temp) { |
394 | /* truly void, because dXSARGS not invoked */ | |
395 | PL_markstack_ptr = temp; | |
396 | XSRETURN_EMPTY; /* return empty stack */ | |
397 | } | |
398 | /* must have used dXSARGS; list context implied */ | |
399 | return; /* assume stack size is correct */ | |
400 |