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