Commit | Line | Data |
68795e93 |
1 | #define PERL_NO_GET_CONTEXT |
2 | #include "EXTERN.h" |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
5 | |
73e09c8f |
6 | #ifdef USE_ITHREADS |
7 | |
68795e93 |
8 | #ifdef WIN32 |
9 | #include <windows.h> |
10 | #include <win32thread.h> |
11 | #define PERL_THREAD_SETSPECIFIC(k,v) TlsSetValue(k,v) |
12 | #define PERL_THREAD_GETSPECIFIC(k,v) v = TlsGetValue(k) |
13 | #define PERL_THREAD_ALLOC_SPECIFIC(k) \ |
14 | STMT_START {\ |
15 | if((k = TlsAlloc()) == TLS_OUT_OF_INDEXES) {\ |
16 | PerlIO_printf(PerlIO_stderr(),"panic threads.h: TlsAlloc");\ |
17 | exit(1);\ |
18 | }\ |
19 | } STMT_END |
20 | #else |
21 | #include <pthread.h> |
22 | #include <thread.h> |
23 | |
24 | #define PERL_THREAD_SETSPECIFIC(k,v) pthread_setspecific(k,v) |
25 | #ifdef OLD_PTHREADS_API |
26 | #define PERL_THREAD_DETACH(t) pthread_detach(&(t)) |
27 | #define PERL_THREAD_GETSPECIFIC(k,v) pthread_getspecific(k,&v) |
28 | #define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\ |
29 | if(pthread_keycreate(&(k),0)) {\ |
30 | PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\ |
31 | exit(1);\ |
32 | }\ |
33 | } STMT_END |
34 | #else |
35 | #define PERL_THREAD_DETACH(t) pthread_detach((t)) |
36 | #define PERL_THREAD_GETSPECIFIC(k,v) v = pthread_getspecific(k) |
37 | #define PERL_THREAD_ALLOC_SPECIFIC(k) STMT_START {\ |
38 | if(pthread_key_create(&(k),0)) {\ |
39 | PerlIO_printf(PerlIO_stderr(), "panic threads.h: pthread_key_create");\ |
40 | exit(1);\ |
41 | }\ |
42 | } STMT_END |
43 | #endif |
44 | #endif |
45 | |
62375a60 |
46 | /* Values for 'state' member */ |
47 | #define PERL_ITHR_JOINABLE 0 |
48 | #define PERL_ITHR_DETACHED 1 |
49 | #define PERL_ITHR_FINISHED 4 |
50 | #define PERL_ITHR_JOINED 2 |
51 | |
68795e93 |
52 | typedef struct ithread_s { |
53 | struct ithread_s *next; /* next thread in the list */ |
54 | struct ithread_s *prev; /* prev thread in the list */ |
55 | PerlInterpreter *interp; /* The threads interpreter */ |
56 | I32 tid; /* threads module's thread id */ |
57 | perl_mutex mutex; /* mutex for updating things in this struct */ |
58 | I32 count; /* how many SVs have a reference to us */ |
62375a60 |
59 | signed char state; /* are we detached ? */ |
a446a88f |
60 | int gimme; /* Context of create */ |
68795e93 |
61 | SV* init_function; /* Code to run */ |
62 | SV* params; /* args to pass function */ |
63 | #ifdef WIN32 |
64 | DWORD thr; /* OS's idea if thread id */ |
65 | HANDLE handle; /* OS's waitable handle */ |
66 | #else |
67 | pthread_t thr; /* OS's handle for the thread */ |
68 | #endif |
69 | } ithread; |
70 | |
71 | ithread *threads; |
72 | |
73 | /* Macros to supply the aTHX_ in an embed.h like manner */ |
74 | #define ithread_join(thread) Perl_ithread_join(aTHX_ thread) |
75 | #define ithread_DESTROY(thread) Perl_ithread_DESTROY(aTHX_ thread) |
76 | #define ithread_CLONE(thread) Perl_ithread_CLONE(aTHX_ thread) |
77 | #define ithread_detach(thread) Perl_ithread_detach(aTHX_ thread) |
78 | #define ithread_tid(thread) ((thread)->tid) |
f9dff5f5 |
79 | #define ithread_yield(thread) (YIELD); |
68795e93 |
80 | |
58c2ef19 |
81 | static perl_mutex create_destruct_mutex; /* protects the creation and destruction of threads*/ |
68795e93 |
82 | |
83 | I32 tid_counter = 0; |
62375a60 |
84 | I32 known_threads = 0; |
58c2ef19 |
85 | I32 active_threads = 0; |
68795e93 |
86 | perl_key self_key; |
87 | |
88 | /* |
89 | * Clear up after thread is done with |
90 | */ |
91 | void |
62375a60 |
92 | Perl_ithread_destruct (pTHX_ ithread* thread, const char *why) |
68795e93 |
93 | { |
3deee5e7 |
94 | PerlInterpreter* destroyperl = NULL; |
68795e93 |
95 | MUTEX_LOCK(&thread->mutex); |
62375a60 |
96 | if (!thread->next) { |
97 | Perl_croak(aTHX_ "panic: destruct destroyed thread %p (%s)",thread, why); |
98 | } |
68795e93 |
99 | if (thread->count != 0) { |
100 | MUTEX_UNLOCK(&thread->mutex); |
d1400e48 |
101 | return; |
68795e93 |
102 | } |
58c2ef19 |
103 | MUTEX_LOCK(&create_destruct_mutex); |
68795e93 |
104 | /* Remove from circular list of threads */ |
105 | if (thread->next == thread) { |
106 | /* last one should never get here ? */ |
107 | threads = NULL; |
108 | } |
109 | else { |
f42ad631 |
110 | thread->next->prev = thread->prev; |
111 | thread->prev->next = thread->next; |
68795e93 |
112 | if (threads == thread) { |
113 | threads = thread->next; |
114 | } |
62375a60 |
115 | thread->next = NULL; |
116 | thread->prev = NULL; |
68795e93 |
117 | } |
62375a60 |
118 | known_threads--; |
119 | assert( known_threads >= 0 ); |
ba14dd9a |
120 | #if 0 |
62375a60 |
121 | Perl_warn(aTHX_ "destruct %d @ %p by %p now %d", |
122 | thread->tid,thread->interp,aTHX, known_threads); |
ba14dd9a |
123 | #endif |
62375a60 |
124 | MUTEX_UNLOCK(&create_destruct_mutex); |
125 | /* Thread is now disowned */ |
68795e93 |
126 | if (thread->interp) { |
1c3adb19 |
127 | dTHXa(thread->interp); |
68795e93 |
128 | PERL_SET_CONTEXT(thread->interp); |
1c3adb19 |
129 | SvREFCNT_dec(thread->params); |
130 | thread->params = Nullsv; |
3deee5e7 |
131 | destroyperl = thread->interp; |
68795e93 |
132 | thread->interp = NULL; |
133 | } |
d1400e48 |
134 | MUTEX_UNLOCK(&thread->mutex); |
1c3adb19 |
135 | MUTEX_DESTROY(&thread->mutex); |
136 | PerlMemShared_free(thread); |
3deee5e7 |
137 | if(destroyperl) { |
1d784c90 |
138 | ithread* current_thread; |
139 | PERL_THREAD_GETSPECIFIC(self_key,current_thread); |
140 | PERL_THREAD_SETSPECIFIC(self_key,thread); |
3deee5e7 |
141 | perl_destruct(destroyperl); |
142 | perl_free(destroyperl); |
1d784c90 |
143 | PERL_THREAD_SETSPECIFIC(self_key,current_thread); |
144 | |
3deee5e7 |
145 | } |
64821230 |
146 | PERL_SET_CONTEXT(aTHX); |
68795e93 |
147 | } |
148 | |
62375a60 |
149 | int |
150 | Perl_ithread_hook(pTHX) |
151 | { |
152 | int veto_cleanup = 0; |
153 | MUTEX_LOCK(&create_destruct_mutex); |
154 | if (aTHX == PL_curinterp && active_threads != 1) { |
c133c03f |
155 | Perl_warn(aTHX_ "A thread exited while %" IVdf " other threads were still running", |
436c6dd3 |
156 | (IV)active_threads); |
62375a60 |
157 | veto_cleanup = 1; |
158 | } |
159 | MUTEX_UNLOCK(&create_destruct_mutex); |
160 | return veto_cleanup; |
161 | } |
162 | |
163 | void |
164 | Perl_ithread_detach(pTHX_ ithread *thread) |
165 | { |
166 | MUTEX_LOCK(&thread->mutex); |
167 | if (!(thread->state & (PERL_ITHR_DETACHED|PERL_ITHR_JOINED))) { |
168 | thread->state |= PERL_ITHR_DETACHED; |
169 | #ifdef WIN32 |
170 | CloseHandle(thread->handle); |
171 | thread->handle = 0; |
172 | #else |
173 | PERL_THREAD_DETACH(thread->thr); |
174 | #endif |
175 | } |
176 | if ((thread->state & PERL_ITHR_FINISHED) && |
177 | (thread->state & PERL_ITHR_DETACHED)) { |
178 | MUTEX_UNLOCK(&thread->mutex); |
179 | Perl_ithread_destruct(aTHX_ thread, "detach"); |
180 | } |
181 | else { |
182 | MUTEX_UNLOCK(&thread->mutex); |
183 | } |
184 | } |
68795e93 |
185 | |
186 | /* MAGIC (in mg.h sense) hooks */ |
187 | |
188 | int |
189 | ithread_mg_get(pTHX_ SV *sv, MAGIC *mg) |
190 | { |
191 | ithread *thread = (ithread *) mg->mg_ptr; |
192 | SvIVX(sv) = PTR2IV(thread); |
193 | SvIOK_on(sv); |
194 | return 0; |
195 | } |
196 | |
197 | int |
198 | ithread_mg_free(pTHX_ SV *sv, MAGIC *mg) |
199 | { |
200 | ithread *thread = (ithread *) mg->mg_ptr; |
201 | MUTEX_LOCK(&thread->mutex); |
68795e93 |
202 | thread->count--; |
62375a60 |
203 | if (thread->count == 0) { |
1c3adb19 |
204 | if(thread->state & PERL_ITHR_FINISHED && |
205 | (thread->state & PERL_ITHR_DETACHED || |
206 | thread->state & PERL_ITHR_JOINED)) |
207 | { |
208 | MUTEX_UNLOCK(&thread->mutex); |
209 | Perl_ithread_destruct(aTHX_ thread, "no reference"); |
210 | } |
1ea20f42 |
211 | else { |
212 | MUTEX_UNLOCK(&thread->mutex); |
213 | } |
62375a60 |
214 | } |
215 | else { |
216 | MUTEX_UNLOCK(&thread->mutex); |
217 | } |
68795e93 |
218 | return 0; |
219 | } |
220 | |
221 | int |
222 | ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) |
223 | { |
224 | ithread *thread = (ithread *) mg->mg_ptr; |
225 | MUTEX_LOCK(&thread->mutex); |
68795e93 |
226 | thread->count++; |
227 | MUTEX_UNLOCK(&thread->mutex); |
228 | return 0; |
229 | } |
230 | |
231 | MGVTBL ithread_vtbl = { |
232 | ithread_mg_get, /* get */ |
233 | 0, /* set */ |
234 | 0, /* len */ |
235 | 0, /* clear */ |
236 | ithread_mg_free, /* free */ |
237 | 0, /* copy */ |
238 | ithread_mg_dup /* dup */ |
239 | }; |
240 | |
47ba8780 |
241 | |
47ba8780 |
242 | /* |
b1edfb69 |
243 | * Starts executing the thread. Needs to clean up memory a tad better. |
68795e93 |
244 | * Passed as the C level function to run in the new thread |
b1edfb69 |
245 | */ |
47ba8780 |
246 | |
247 | #ifdef WIN32 |
68795e93 |
248 | THREAD_RET_TYPE |
249 | Perl_ithread_run(LPVOID arg) { |
47ba8780 |
250 | #else |
68795e93 |
251 | void* |
252 | Perl_ithread_run(void * arg) { |
47ba8780 |
253 | #endif |
5b414d21 |
254 | ithread* thread = (ithread*) arg; |
47ba8780 |
255 | dTHXa(thread->interp); |
47ba8780 |
256 | PERL_SET_CONTEXT(thread->interp); |
68795e93 |
257 | PERL_THREAD_SETSPECIFIC(self_key,thread); |
47ba8780 |
258 | |
68795e93 |
259 | #if 0 |
260 | /* Far from clear messing with ->thr child-side is a good idea */ |
261 | MUTEX_LOCK(&thread->mutex); |
47ba8780 |
262 | #ifdef WIN32 |
263 | thread->thr = GetCurrentThreadId(); |
264 | #else |
265 | thread->thr = pthread_self(); |
266 | #endif |
68795e93 |
267 | MUTEX_UNLOCK(&thread->mutex); |
268 | #endif |
47ba8780 |
269 | |
47ba8780 |
270 | PL_perl_destruct_level = 2; |
4f896ddc |
271 | |
47ba8780 |
272 | { |
68795e93 |
273 | AV* params = (AV*) SvRV(thread->params); |
274 | I32 len = av_len(params)+1; |
47ba8780 |
275 | int i; |
276 | dSP; |
47ba8780 |
277 | ENTER; |
278 | SAVETMPS; |
279 | PUSHMARK(SP); |
68795e93 |
280 | for(i = 0; i < len; i++) { |
281 | XPUSHs(av_shift(params)); |
47ba8780 |
282 | } |
283 | PUTBACK; |
a446a88f |
284 | len = call_sv(thread->init_function, thread->gimme|G_EVAL); |
0405e91e |
285 | |
68795e93 |
286 | SPAGAIN; |
a446a88f |
287 | for (i=len-1; i >= 0; i--) { |
e1c44605 |
288 | SV *sv = POPs; |
289 | av_store(params, i, SvREFCNT_inc(sv)); |
a446a88f |
290 | } |
a446a88f |
291 | if (SvTRUE(ERRSV)) { |
6b3c7930 |
292 | Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV); |
a446a88f |
293 | } |
47ba8780 |
294 | FREETMPS; |
295 | LEAVE; |
68795e93 |
296 | SvREFCNT_dec(thread->init_function); |
47ba8780 |
297 | } |
298 | |
fd58862f |
299 | PerlIO_flush((PerlIO*)NULL); |
68795e93 |
300 | MUTEX_LOCK(&thread->mutex); |
62375a60 |
301 | thread->state |= PERL_ITHR_FINISHED; |
302 | |
303 | if (thread->state & PERL_ITHR_DETACHED) { |
47ba8780 |
304 | MUTEX_UNLOCK(&thread->mutex); |
62375a60 |
305 | Perl_ithread_destruct(aTHX_ thread, "detached finish"); |
47ba8780 |
306 | } else { |
62375a60 |
307 | MUTEX_UNLOCK(&thread->mutex); |
308 | } |
91604d21 |
309 | MUTEX_LOCK(&create_destruct_mutex); |
310 | active_threads--; |
311 | assert( active_threads >= 0 ); |
312 | MUTEX_UNLOCK(&create_destruct_mutex); |
313 | |
47ba8780 |
314 | #ifdef WIN32 |
315 | return (DWORD)0; |
e8f2bb9a |
316 | #else |
317 | return 0; |
47ba8780 |
318 | #endif |
68795e93 |
319 | } |
320 | |
321 | SV * |
322 | ithread_to_SV(pTHX_ SV *obj, ithread *thread, char *classname, bool inc) |
323 | { |
324 | SV *sv; |
325 | MAGIC *mg; |
326 | if (inc) { |
327 | MUTEX_LOCK(&thread->mutex); |
328 | thread->count++; |
68795e93 |
329 | MUTEX_UNLOCK(&thread->mutex); |
330 | } |
331 | if (!obj) |
332 | obj = newSV(0); |
333 | sv = newSVrv(obj,classname); |
334 | sv_setiv(sv,PTR2IV(thread)); |
335 | mg = sv_magicext(sv,Nullsv,PERL_MAGIC_shared_scalar,&ithread_vtbl,(char *)thread,0); |
336 | mg->mg_flags |= MGf_DUP; |
337 | SvREADONLY_on(sv); |
338 | return obj; |
339 | } |
47ba8780 |
340 | |
68795e93 |
341 | ithread * |
342 | SV_to_ithread(pTHX_ SV *sv) |
343 | { |
344 | ithread *thread; |
345 | if (SvROK(sv)) |
346 | { |
347 | thread = INT2PTR(ithread*, SvIV(SvRV(sv))); |
348 | } |
349 | else |
350 | { |
351 | PERL_THREAD_GETSPECIFIC(self_key,thread); |
352 | } |
353 | return thread; |
47ba8780 |
354 | } |
355 | |
47ba8780 |
356 | /* |
68795e93 |
357 | * iThread->create(); ( aka iThread->new() ) |
358 | * Called in context of parent thread |
b1edfb69 |
359 | */ |
47ba8780 |
360 | |
68795e93 |
361 | SV * |
362 | Perl_ithread_create(pTHX_ SV *obj, char* classname, SV* init_function, SV* params) |
363 | { |
364 | ithread* thread; |
365 | CLONE_PARAMS clone_param; |
1d784c90 |
366 | ithread* current_thread; |
367 | PERL_THREAD_GETSPECIFIC(self_key,current_thread); |
58c2ef19 |
368 | MUTEX_LOCK(&create_destruct_mutex); |
68795e93 |
369 | thread = PerlMemShared_malloc(sizeof(ithread)); |
370 | Zero(thread,1,ithread); |
371 | thread->next = threads; |
372 | thread->prev = threads->prev; |
f42ad631 |
373 | threads->prev = thread; |
68795e93 |
374 | thread->prev->next = thread; |
375 | /* Set count to 1 immediately in case thread exits before |
376 | * we return to caller ! |
377 | */ |
378 | thread->count = 1; |
379 | MUTEX_INIT(&thread->mutex); |
380 | thread->tid = tid_counter++; |
a446a88f |
381 | thread->gimme = GIMME_V; |
4f896ddc |
382 | |
68795e93 |
383 | /* "Clone" our interpreter into the thread's interpreter |
384 | * This gives thread access to "static data" and code. |
385 | */ |
47ba8780 |
386 | |
68795e93 |
387 | PerlIO_flush((PerlIO*)NULL); |
1d784c90 |
388 | PERL_THREAD_SETSPECIFIC(self_key,thread); |
47ba8780 |
389 | #ifdef WIN32 |
68795e93 |
390 | thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE | CLONEf_CLONE_HOST); |
47ba8780 |
391 | #else |
68795e93 |
392 | thread->interp = perl_clone(aTHX, CLONEf_KEEP_PTR_TABLE); |
47ba8780 |
393 | #endif |
ba14dd9a |
394 | /* perl_clone leaves us in new interpreter's context. |
c8dae523 |
395 | As it is tricky to spot an implicit aTHX, create a new scope |
a446a88f |
396 | with aTHX matching the context for the duration of |
ba14dd9a |
397 | our work for new interpreter. |
398 | */ |
399 | { |
400 | dTHXa(thread->interp); |
58c2ef19 |
401 | /* Here we remove END blocks since they should only run |
62375a60 |
402 | in the thread they are created |
58c2ef19 |
403 | */ |
404 | SvREFCNT_dec(PL_endav); |
405 | PL_endav = newAV(); |
d1400e48 |
406 | clone_param.flags = 0; |
ba14dd9a |
407 | thread->init_function = sv_dup(init_function, &clone_param); |
408 | if (SvREFCNT(thread->init_function) == 0) { |
409 | SvREFCNT_inc(thread->init_function); |
d1400e48 |
410 | } |
ba14dd9a |
411 | |
412 | thread->params = sv_dup(params, &clone_param); |
413 | SvREFCNT_inc(thread->params); |
414 | SvTEMP_off(thread->init_function); |
415 | ptr_table_free(PL_ptr_table); |
416 | PL_ptr_table = NULL; |
ffb29f90 |
417 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
ba14dd9a |
418 | } |
1d784c90 |
419 | PERL_THREAD_SETSPECIFIC(self_key,current_thread); |
68795e93 |
420 | PERL_SET_CONTEXT(aTHX); |
47ba8780 |
421 | |
68795e93 |
422 | /* Start the thread */ |
47ba8780 |
423 | |
424 | #ifdef WIN32 |
425 | |
68795e93 |
426 | thread->handle = CreateThread(NULL, 0, Perl_ithread_run, |
47ba8780 |
427 | (LPVOID)thread, 0, &thread->thr); |
428 | |
82c40bf6 |
429 | #else |
fa26028c |
430 | { |
431 | static pthread_attr_t attr; |
432 | static int attr_inited = 0; |
fa26028c |
433 | static int attr_joinable = PTHREAD_CREATE_JOINABLE; |
434 | if (!attr_inited) { |
435 | attr_inited = 1; |
436 | pthread_attr_init(&attr); |
437 | } |
438 | # ifdef PTHREAD_ATTR_SETDETACHSTATE |
439 | PTHREAD_ATTR_SETDETACHSTATE(&attr, attr_joinable); |
440 | # endif |
3eb37d38 |
441 | # ifdef THREAD_CREATE_NEEDS_STACK |
442 | if(pthread_attr_setstacksize(&attr, THREAD_CREATE_NEEDS_STACK)) |
443 | croak("panic: pthread_attr_setstacksize failed"); |
444 | # endif |
445 | |
3ad0b7d6 |
446 | #ifdef OLD_PTHREADS_API |
68795e93 |
447 | pthread_create( &thread->thr, attr, Perl_ithread_run, (void *)thread); |
47ba8780 |
448 | #else |
68795e93 |
449 | pthread_create( &thread->thr, &attr, Perl_ithread_run, (void *)thread); |
47ba8780 |
450 | #endif |
3ad0b7d6 |
451 | } |
82c40bf6 |
452 | #endif |
62375a60 |
453 | known_threads++; |
58c2ef19 |
454 | active_threads++; |
455 | MUTEX_UNLOCK(&create_destruct_mutex); |
95393226 |
456 | sv_2mortal(params); |
68795e93 |
457 | return ithread_to_SV(aTHX_ obj, thread, classname, FALSE); |
458 | } |
47ba8780 |
459 | |
68795e93 |
460 | SV* |
461 | Perl_ithread_self (pTHX_ SV *obj, char* Class) |
462 | { |
463 | ithread *thread; |
464 | PERL_THREAD_GETSPECIFIC(self_key,thread); |
465 | return ithread_to_SV(aTHX_ obj, thread, Class, TRUE); |
47ba8780 |
466 | } |
467 | |
468 | /* |
e1c44605 |
469 | * Joins the thread this code needs to take the returnvalue from the |
68795e93 |
470 | * call_sv and send it back |
b1edfb69 |
471 | */ |
47ba8780 |
472 | |
68795e93 |
473 | void |
474 | Perl_ithread_CLONE(pTHX_ SV *obj) |
475 | { |
476 | if (SvROK(obj)) |
477 | { |
478 | ithread *thread = SV_to_ithread(aTHX_ obj); |
479 | } |
480 | else |
481 | { |
436c6dd3 |
482 | Perl_warn(aTHX_ "CLONE %" SVf,obj); |
68795e93 |
483 | } |
47ba8780 |
484 | } |
485 | |
62375a60 |
486 | AV* |
68795e93 |
487 | Perl_ithread_join(pTHX_ SV *obj) |
488 | { |
489 | ithread *thread = SV_to_ithread(aTHX_ obj); |
490 | MUTEX_LOCK(&thread->mutex); |
62375a60 |
491 | if (thread->state & PERL_ITHR_DETACHED) { |
a446a88f |
492 | MUTEX_UNLOCK(&thread->mutex); |
493 | Perl_croak(aTHX_ "Cannot join a detached thread"); |
494 | } |
62375a60 |
495 | else if (thread->state & PERL_ITHR_JOINED) { |
a446a88f |
496 | MUTEX_UNLOCK(&thread->mutex); |
497 | Perl_croak(aTHX_ "Thread already joined"); |
498 | } |
499 | else { |
e1c44605 |
500 | AV* retparam; |
47ba8780 |
501 | #ifdef WIN32 |
502 | DWORD waitcode; |
47ba8780 |
503 | #else |
504 | void *retval; |
47ba8780 |
505 | #endif |
47ba8780 |
506 | MUTEX_UNLOCK(&thread->mutex); |
68795e93 |
507 | #ifdef WIN32 |
508 | waitcode = WaitForSingleObject(thread->handle, INFINITE); |
509 | #else |
510 | pthread_join(thread->thr,&retval); |
511 | #endif |
47ba8780 |
512 | MUTEX_LOCK(&thread->mutex); |
e1c44605 |
513 | |
62375a60 |
514 | /* sv_dup over the args */ |
e1c44605 |
515 | { |
1d784c90 |
516 | ithread* current_thread; |
62375a60 |
517 | AV* params = (AV*) SvRV(thread->params); |
e1c44605 |
518 | CLONE_PARAMS clone_params; |
3275ba96 |
519 | clone_params.stashes = newAV(); |
0405e91e |
520 | clone_params.flags |= CLONEf_JOIN_IN; |
e1c44605 |
521 | PL_ptr_table = ptr_table_new(); |
1d784c90 |
522 | PERL_THREAD_GETSPECIFIC(self_key,current_thread); |
523 | PERL_THREAD_SETSPECIFIC(self_key,thread); |
0405e91e |
524 | |
525 | { |
526 | I32 len = av_len(params)+1; |
527 | I32 i; |
528 | for(i = 0; i < len; i++) { |
529 | // sv_dump(SvRV(AvARRAY(params)[i])); |
530 | } |
531 | } |
532 | |
e1c44605 |
533 | retparam = (AV*) sv_dup((SV*)params, &clone_params); |
b4cb676b |
534 | #if 0 |
0405e91e |
535 | { |
536 | I32 len = av_len(retparam)+1; |
537 | I32 i; |
538 | for(i = 0; i < len; i++) { |
b4cb676b |
539 | sv_dump(SvRV(AvARRAY(retparam)[i])); |
0405e91e |
540 | } |
541 | } |
b4cb676b |
542 | #endif |
1d784c90 |
543 | PERL_THREAD_SETSPECIFIC(self_key,current_thread); |
3275ba96 |
544 | SvREFCNT_dec(clone_params.stashes); |
e1c44605 |
545 | SvREFCNT_inc(retparam); |
546 | ptr_table_free(PL_ptr_table); |
547 | PL_ptr_table = NULL; |
548 | |
549 | } |
a446a88f |
550 | /* We have finished with it */ |
62375a60 |
551 | thread->state |= PERL_ITHR_JOINED; |
47ba8780 |
552 | MUTEX_UNLOCK(&thread->mutex); |
9684265f |
553 | sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar); |
e1c44605 |
554 | return retparam; |
68795e93 |
555 | } |
e1c44605 |
556 | return (AV*)NULL; |
47ba8780 |
557 | } |
558 | |
68795e93 |
559 | void |
68795e93 |
560 | Perl_ithread_DESTROY(pTHX_ SV *sv) |
561 | { |
562 | ithread *thread = SV_to_ithread(aTHX_ sv); |
68795e93 |
563 | sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar); |
564 | } |
8222d950 |
565 | |
73e09c8f |
566 | #endif /* USE_ITHREADS */ |
e1c44605 |
567 | |
68795e93 |
568 | MODULE = threads PACKAGE = threads PREFIX = ithread_ |
569 | PROTOTYPES: DISABLE |
8222d950 |
570 | |
73e09c8f |
571 | #ifdef USE_ITHREADS |
572 | |
68795e93 |
573 | void |
574 | ithread_new (classname, function_to_call, ...) |
575 | char * classname |
576 | SV * function_to_call |
577 | CODE: |
578 | { |
579 | AV* params = newAV(); |
580 | if (items > 2) { |
581 | int i; |
582 | for(i = 2; i < items ; i++) { |
95393226 |
583 | av_push(params, SvREFCNT_inc(ST(i))); |
68795e93 |
584 | } |
585 | } |
586 | ST(0) = sv_2mortal(Perl_ithread_create(aTHX_ Nullsv, classname, function_to_call, newRV_noinc((SV*) params))); |
587 | XSRETURN(1); |
588 | } |
8222d950 |
589 | |
68795e93 |
590 | void |
678a9b6c |
591 | ithread_list(char *classname) |
592 | PPCODE: |
593 | { |
594 | ithread *curr_thread; |
595 | MUTEX_LOCK(&create_destruct_mutex); |
596 | curr_thread = threads; |
5eb9fe8f |
597 | if(curr_thread->tid != 0) |
598 | PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE))); |
678a9b6c |
599 | while(curr_thread) { |
678a9b6c |
600 | curr_thread = curr_thread->next; |
601 | if(curr_thread == threads) |
602 | break; |
6794f985 |
603 | if(curr_thread->state & PERL_ITHR_DETACHED || |
5eb9fe8f |
604 | curr_thread->state & PERL_ITHR_JOINED) |
605 | continue; |
606 | PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE))); |
678a9b6c |
607 | } |
608 | MUTEX_UNLOCK(&create_destruct_mutex); |
609 | } |
610 | |
611 | |
612 | void |
68795e93 |
613 | ithread_self(char *classname) |
614 | CODE: |
615 | { |
616 | ST(0) = sv_2mortal(Perl_ithread_self(aTHX_ Nullsv,classname)); |
617 | XSRETURN(1); |
618 | } |
47ba8780 |
619 | |
620 | int |
68795e93 |
621 | ithread_tid(ithread *thread) |
47ba8780 |
622 | |
623 | void |
68795e93 |
624 | ithread_join(SV *obj) |
e1c44605 |
625 | PPCODE: |
626 | { |
627 | AV* params = Perl_ithread_join(aTHX_ obj); |
628 | int i; |
629 | I32 len = AvFILL(params); |
630 | for (i = 0; i <= len; i++) { |
1c3adb19 |
631 | SV* tmp = av_shift(params); |
632 | XPUSHs(tmp); |
633 | sv_2mortal(tmp); |
e1c44605 |
634 | } |
635 | SvREFCNT_dec(params); |
636 | } |
637 | |
f9dff5f5 |
638 | void |
9d7debe1 |
639 | yield(...) |
70f2e746 |
640 | CODE: |
641 | { |
642 | YIELD; |
643 | } |
644 | |
47ba8780 |
645 | |
646 | void |
68795e93 |
647 | ithread_detach(ithread *thread) |
47ba8780 |
648 | |
47ba8780 |
649 | void |
68795e93 |
650 | ithread_DESTROY(SV *thread) |
651 | |
73e09c8f |
652 | #endif /* USE_ITHREADS */ |
653 | |
68795e93 |
654 | BOOT: |
655 | { |
73e09c8f |
656 | #ifdef USE_ITHREADS |
68795e93 |
657 | ithread* thread; |
e1c44605 |
658 | PL_perl_destruct_level = 2; |
68795e93 |
659 | PERL_THREAD_ALLOC_SPECIFIC(self_key); |
58c2ef19 |
660 | MUTEX_INIT(&create_destruct_mutex); |
661 | MUTEX_LOCK(&create_destruct_mutex); |
62375a60 |
662 | PL_threadhook = &Perl_ithread_hook; |
68795e93 |
663 | thread = PerlMemShared_malloc(sizeof(ithread)); |
664 | Zero(thread,1,ithread); |
665 | PL_perl_destruct_level = 2; |
666 | MUTEX_INIT(&thread->mutex); |
667 | threads = thread; |
668 | thread->next = thread; |
669 | thread->prev = thread; |
670 | thread->interp = aTHX; |
671 | thread->count = 1; /* imortal */ |
672 | thread->tid = tid_counter++; |
62375a60 |
673 | known_threads++; |
58c2ef19 |
674 | active_threads++; |
62375a60 |
675 | thread->state = 1; |
68795e93 |
676 | #ifdef WIN32 |
677 | thread->thr = GetCurrentThreadId(); |
678 | #else |
679 | thread->thr = pthread_self(); |
680 | #endif |
62375a60 |
681 | |
68795e93 |
682 | PERL_THREAD_SETSPECIFIC(self_key,thread); |
58c2ef19 |
683 | MUTEX_UNLOCK(&create_destruct_mutex); |
73e09c8f |
684 | #endif /* USE_ITHREADS */ |
68795e93 |
685 | } |
686 | |