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