Commit | Line | Data |
d9bb3666 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
7d901afa |
5 | /* Magic signature for Thread's mg_private is "Th" */ |
6 | #define Thread_MAGIC_SIGNATURE 0x5468 |
7 | |
f0f333f4 |
8 | #ifdef __cplusplus |
9 | #ifdef I_UNISTD |
10 | #include <unistd.h> |
11 | #endif |
12 | #endif |
13 | #include <fcntl.h> |
14 | |
7d901afa |
15 | static U32 threadnum = 0; |
85ced67f |
16 | static int sig_pipe[2]; |
f0f333f4 |
17 | |
18 | #ifndef THREAD_RET_TYPE |
f0f333f4 |
19 | #define THREAD_RET_TYPE void * |
20 | #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x) |
458fb581 |
21 | #endif |
683929b4 |
22 | |
7d901afa |
23 | static void |
52e1cb5e |
24 | remove_thread(struct perl_thread *t) |
7d901afa |
25 | { |
f0f333f4 |
26 | #ifdef USE_THREADS |
7d901afa |
27 | DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), |
28 | "%p: remove_thread %p\n", thr, t))); |
29 | MUTEX_LOCK(&threads_mutex); |
0a00ffdb |
30 | MUTEX_DESTROY(&t->mutex); |
7d901afa |
31 | nthreads--; |
32 | t->prev->next = t->next; |
33 | t->next->prev = t->prev; |
34 | COND_BROADCAST(&nthreads_cond); |
35 | MUTEX_UNLOCK(&threads_mutex); |
f0f333f4 |
36 | #endif |
7d901afa |
37 | } |
38 | |
ea0efc06 |
39 | static THREAD_RET_TYPE |
f0f333f4 |
40 | threadstart(void *arg) |
d9bb3666 |
41 | { |
f0f333f4 |
42 | #ifdef USE_THREADS |
783070da |
43 | #ifdef FAKE_THREADS |
44 | Thread savethread = thr; |
45 | LOGOP myop; |
46 | dSP; |
47 | I32 oldscope = scopestack_ix; |
48 | I32 retval; |
458fb581 |
49 | AV *av; |
783070da |
50 | int i; |
51 | |
683929b4 |
52 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", |
53 | thr, SvPEEK(TOPs))); |
783070da |
54 | thr = (Thread) arg; |
55 | savemark = TOPMARK; |
56 | thr->prev = thr->prev_run = savethread; |
57 | thr->next = savethread->next; |
58 | thr->next_run = savethread->next_run; |
59 | savethread->next = savethread->next_run = thr; |
60 | thr->wait_queue = 0; |
61 | thr->private = 0; |
62 | |
63 | /* Now duplicate most of perl_call_sv but with a few twists */ |
64 | op = (OP*)&myop; |
65 | Zero(op, 1, LOGOP); |
66 | myop.op_flags = OPf_STACKED; |
67 | myop.op_next = Nullop; |
68 | myop.op_flags |= OPf_KNOW; |
69 | myop.op_flags |= OPf_WANT_LIST; |
70 | op = pp_entersub(ARGS); |
71 | DEBUG_L(if (!op) |
72 | PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); |
73 | /* |
74 | * When this thread is next scheduled, we start in the right |
75 | * place. When the thread runs off the end of the sub, perl.c |
76 | * handles things, using savemark to figure out how much of the |
77 | * stack is the return value for any join. |
78 | */ |
79 | thr = savethread; /* back to the old thread */ |
80 | return 0; |
81 | #else |
d9bb3666 |
82 | Thread thr = (Thread) arg; |
83 | LOGOP myop; |
4e35701f |
84 | djSP; |
d9bb3666 |
85 | I32 oldmark = TOPMARK; |
86 | I32 oldscope = scopestack_ix; |
87 | I32 retval; |
458fb581 |
88 | SV *sv; |
89 | AV *av = newAV(); |
14fcddff |
90 | int i, ret; |
783070da |
91 | dJMPENV; |
0b9678a8 |
92 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", |
93 | thr)); |
783070da |
94 | |
0b9678a8 |
95 | /* Don't call *anything* requiring dTHR until after SET_THR() */ |
d9bb3666 |
96 | /* |
97 | * Wait until our creator releases us. If we didn't do this, then |
98 | * it would be potentially possible for out thread to carry on and |
99 | * do stuff before our creator fills in our "self" field. For example, |
ea0efc06 |
100 | * if we went and created another thread which tried to JOIN with us, |
101 | * then we'd be in a mess. |
d9bb3666 |
102 | */ |
50112d62 |
103 | MUTEX_LOCK(&thr->mutex); |
104 | MUTEX_UNLOCK(&thr->mutex); |
d9bb3666 |
105 | |
d9bb3666 |
106 | /* |
107 | * It's safe to wait until now to set the thread-specific pointer |
52e1cb5e |
108 | * from our pthread_t structure to our struct perl_thread, since |
109 | * we're the only thread who can get at it anyway. |
d9bb3666 |
110 | */ |
ea0efc06 |
111 | SET_THR(thr); |
d9bb3666 |
112 | |
783070da |
113 | /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ |
683929b4 |
114 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", |
115 | thr, SvPEEK(TOPs))); |
783070da |
116 | |
458fb581 |
117 | sv = POPs; |
118 | PUTBACK; |
119 | perl_call_sv(sv, G_ARRAY|G_EVAL); |
734689b1 |
120 | SPAGAIN; |
121 | retval = sp - (stack_base + oldmark); |
122 | sp = stack_base + oldmark + 1; |
458fb581 |
123 | if (SvCUR(thr->errsv)) { |
124 | MUTEX_LOCK(&thr->mutex); |
125 | thr->flags |= THRf_DID_DIE; |
126 | MUTEX_UNLOCK(&thr->mutex); |
127 | av_store(av, 0, &sv_no); |
128 | av_store(av, 1, newSVsv(thr->errsv)); |
129 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", |
dd4ea8b4 |
130 | SvPV(thr->errsv, na))); |
458fb581 |
131 | } else { |
132 | DEBUG_L(STMT_START { |
133 | for (i = 1; i <= retval; i++) { |
134 | PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", |
dd4ea8b4 |
135 | thr, i, SvPEEK(sp[i - 1])); |
458fb581 |
136 | } |
137 | } STMT_END); |
138 | av_store(av, 0, &sv_yes); |
139 | for (i = 1; i <= retval; i++, sp++) |
140 | sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*sp)); |
141 | } |
142 | |
d9bb3666 |
143 | finishoff: |
783070da |
144 | #if 0 |
145 | /* removed for debug */ |
146 | SvREFCNT_dec(curstack); |
147 | #endif |
199100c8 |
148 | SvREFCNT_dec(thr->cvcache); |
54b9620d |
149 | SvREFCNT_dec(thr->threadsv); |
554b3eca |
150 | SvREFCNT_dec(thr->specific); |
38a03e6e |
151 | SvREFCNT_dec(thr->errsv); |
152 | SvREFCNT_dec(thr->errhv); |
d9bb3666 |
153 | Safefree(markstack); |
154 | Safefree(scopestack); |
155 | Safefree(savestack); |
156 | Safefree(retstack); |
157 | Safefree(cxstack); |
158 | Safefree(tmps_stack); |
199100c8 |
159 | Safefree(ofs); |
d9bb3666 |
160 | |
14fcddff |
161 | MUTEX_LOCK(&thr->mutex); |
50112d62 |
162 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
163 | "%p: threadstart finishing: state is %u\n", |
164 | thr, ThrSTATE(thr))); |
14fcddff |
165 | switch (ThrSTATE(thr)) { |
166 | case THRf_R_JOINABLE: |
167 | ThrSETSTATE(thr, THRf_ZOMBIE); |
168 | MUTEX_UNLOCK(&thr->mutex); |
783070da |
169 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
14fcddff |
170 | "%p: R_JOINABLE thread finished\n", thr)); |
171 | break; |
172 | case THRf_R_JOINED: |
173 | ThrSETSTATE(thr, THRf_DEAD); |
174 | MUTEX_UNLOCK(&thr->mutex); |
50112d62 |
175 | remove_thread(thr); |
14fcddff |
176 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
177 | "%p: R_JOINED thread finished\n", thr)); |
178 | break; |
50112d62 |
179 | case THRf_R_DETACHED: |
683929b4 |
180 | ThrSETSTATE(thr, THRf_DEAD); |
14fcddff |
181 | MUTEX_UNLOCK(&thr->mutex); |
458fb581 |
182 | SvREFCNT_dec(av); |
14fcddff |
183 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
184 | "%p: DETACHED thread finished\n", thr)); |
50112d62 |
185 | remove_thread(thr); /* This might trigger main thread to finish */ |
14fcddff |
186 | break; |
187 | default: |
188 | MUTEX_UNLOCK(&thr->mutex); |
189 | croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr)); |
190 | /* NOTREACHED */ |
734689b1 |
191 | } |
458fb581 |
192 | return THREAD_RET_CAST(av); /* Available for anyone to join with */ |
ea0efc06 |
193 | /* us unless we're detached, in which */ |
194 | /* case noone sees the value anyway. */ |
783070da |
195 | #endif |
f0f333f4 |
196 | #else |
197 | return THREAD_RET_CAST(NULL); |
198 | #endif |
d9bb3666 |
199 | } |
200 | |
683929b4 |
201 | static SV * |
458fb581 |
202 | newthread (SV *startsv, AV *initargs, char *classname) |
d9bb3666 |
203 | { |
f0f333f4 |
204 | #ifdef USE_THREADS |
d9bb3666 |
205 | dSP; |
206 | Thread savethread; |
207 | int i; |
683929b4 |
208 | SV *sv; |
ea0efc06 |
209 | int err; |
210 | #ifndef THREAD_CREATE |
f152979c |
211 | sigset_t fullmask, oldmask; |
ea0efc06 |
212 | #endif |
d9bb3666 |
213 | |
214 | savethread = thr; |
a863c7d1 |
215 | thr = new_struct_thread(thr); |
d9bb3666 |
216 | SPAGAIN; |
50112d62 |
217 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
0b9678a8 |
218 | "%p: newthread (%p), tid is %u, preparing stack\n", |
219 | savethread, thr, thr->tid)); |
d9bb3666 |
220 | /* The following pushes the arg list and startsv onto the *new* stack */ |
221 | PUSHMARK(sp); |
222 | /* Could easily speed up the following greatly */ |
734689b1 |
223 | for (i = 0; i <= AvFILL(initargs); i++) |
d9bb3666 |
224 | XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); |
225 | XPUSHs(SvREFCNT_inc(startsv)); |
226 | PUTBACK; |
ea0efc06 |
227 | #ifdef THREAD_CREATE |
f0f333f4 |
228 | err = THREAD_CREATE(thr, threadstart); |
783070da |
229 | #else |
d9bb3666 |
230 | /* On your marks... */ |
14fcddff |
231 | MUTEX_LOCK(&thr->mutex); |
ea0efc06 |
232 | /* Get set... */ |
f152979c |
233 | sigfillset(&fullmask); |
234 | if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) |
235 | croak("panic: sigprocmask"); |
52e1cb5e |
236 | #ifdef PTHREADS_CREATED_JOINABLE |
46930d8f |
237 | err = pthread_create(&thr->self, pthread_attr_default, |
238 | threadstart, (void*) thr); |
52e1cb5e |
239 | #else |
240 | { |
241 | pthread_attr_t attr; |
242 | |
243 | err = pthread_attr_init(&attr); |
244 | if (err == 0) { |
245 | #ifdef PTHREAD_CREATE_UNDETACHED |
246 | err = pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_UNDETACHED); |
247 | #else |
248 | croak("panic: pthread_attr_setdetachstate"); |
249 | #endif |
250 | if (err == 0) |
251 | err = pthread_create(&thr->self, &attr, |
252 | threadstart, (void*) thr); |
253 | } |
254 | pthread_attr_destroy(&attr); |
255 | } |
256 | #endif |
d9bb3666 |
257 | /* Go */ |
14fcddff |
258 | MUTEX_UNLOCK(&thr->mutex); |
ea0efc06 |
259 | #endif |
260 | if (err) { |
0b9678a8 |
261 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
262 | "%p: create of %p failed %d\n", savethread, thr, err)); |
ea0efc06 |
263 | /* Thread creation failed--clean up */ |
199100c8 |
264 | SvREFCNT_dec(thr->cvcache); |
ea0efc06 |
265 | remove_thread(thr); |
266 | MUTEX_DESTROY(&thr->mutex); |
267 | for (i = 0; i <= AvFILL(initargs); i++) |
268 | SvREFCNT_dec(*av_fetch(initargs, i, FALSE)); |
269 | SvREFCNT_dec(startsv); |
270 | return NULL; |
271 | } |
272 | #ifdef THREAD_POST_CREATE |
273 | THREAD_POST_CREATE(thr); |
274 | #else |
f152979c |
275 | if (sigprocmask(SIG_SETMASK, &oldmask, 0)) |
276 | croak("panic: sigprocmask"); |
783070da |
277 | #endif |
7d901afa |
278 | sv = newSViv(thr->tid); |
199100c8 |
279 | sv_magic(sv, thr->oursv, '~', 0, 0); |
7d901afa |
280 | SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; |
458fb581 |
281 | return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); |
f0f333f4 |
282 | #else |
283 | croak("No threads in this perl"); |
284 | return &sv_undef; |
285 | #endif |
d9bb3666 |
286 | } |
287 | |
f0f333f4 |
288 | static Signal_t handle_thread_signal _((int sig)); |
289 | |
f152979c |
290 | static Signal_t |
f0f333f4 |
291 | handle_thread_signal(int sig) |
f152979c |
292 | { |
293 | char c = (char) sig; |
294 | write(sig_pipe[0], &c, 1); |
295 | } |
296 | |
d9bb3666 |
297 | MODULE = Thread PACKAGE = Thread |
0b9678a8 |
298 | PROTOTYPES: DISABLE |
d9bb3666 |
299 | |
683929b4 |
300 | void |
458fb581 |
301 | new(classname, startsv, ...) |
302 | char * classname |
d9bb3666 |
303 | SV * startsv |
734689b1 |
304 | AV * av = av_make(items - 2, &ST(2)); |
683929b4 |
305 | PPCODE: |
458fb581 |
306 | XPUSHs(sv_2mortal(newthread(startsv, av, classname))); |
d9bb3666 |
307 | |
308 | void |
d9bb3666 |
309 | join(t) |
310 | Thread t |
311 | AV * av = NO_INIT |
312 | int i = NO_INIT |
313 | PPCODE: |
f0f333f4 |
314 | #ifdef USE_THREADS |
7d901afa |
315 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", |
316 | thr, t, ThrSTATE(t));); |
50112d62 |
317 | MUTEX_LOCK(&t->mutex); |
318 | switch (ThrSTATE(t)) { |
14fcddff |
319 | case THRf_R_JOINABLE: |
320 | case THRf_R_JOINED: |
50112d62 |
321 | ThrSETSTATE(t, THRf_R_JOINED); |
322 | MUTEX_UNLOCK(&t->mutex); |
14fcddff |
323 | break; |
324 | case THRf_ZOMBIE: |
50112d62 |
325 | ThrSETSTATE(t, THRf_DEAD); |
326 | MUTEX_UNLOCK(&t->mutex); |
327 | remove_thread(t); |
14fcddff |
328 | break; |
329 | default: |
50112d62 |
330 | MUTEX_UNLOCK(&t->mutex); |
14fcddff |
331 | croak("can't join with thread"); |
332 | /* NOTREACHED */ |
333 | } |
ea0efc06 |
334 | JOIN(t, &av); |
7d901afa |
335 | |
458fb581 |
336 | if (SvTRUE(*av_fetch(av, 0, FALSE))) { |
337 | /* Could easily speed up the following if necessary */ |
338 | for (i = 1; i <= AvFILL(av); i++) |
339 | XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); |
340 | } else { |
341 | char *mess = SvPV(*av_fetch(av, 1, FALSE), na); |
342 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), |
343 | "%p: join propagating die message: %s\n", |
344 | thr, mess)); |
345 | croak(mess); |
346 | } |
f0f333f4 |
347 | #endif |
d9bb3666 |
348 | |
349 | void |
734689b1 |
350 | detach(t) |
d9bb3666 |
351 | Thread t |
352 | CODE: |
f0f333f4 |
353 | #ifdef USE_THREADS |
7d901afa |
354 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", |
355 | thr, t, ThrSTATE(t));); |
50112d62 |
356 | MUTEX_LOCK(&t->mutex); |
357 | switch (ThrSTATE(t)) { |
14fcddff |
358 | case THRf_R_JOINABLE: |
50112d62 |
359 | ThrSETSTATE(t, THRf_R_DETACHED); |
14fcddff |
360 | /* fall through */ |
50112d62 |
361 | case THRf_R_DETACHED: |
14fcddff |
362 | DETACH(t); |
50112d62 |
363 | MUTEX_UNLOCK(&t->mutex); |
14fcddff |
364 | break; |
365 | case THRf_ZOMBIE: |
50112d62 |
366 | ThrSETSTATE(t, THRf_DEAD); |
7d901afa |
367 | DETACH(t); |
50112d62 |
368 | MUTEX_UNLOCK(&t->mutex); |
369 | remove_thread(t); |
14fcddff |
370 | break; |
371 | default: |
50112d62 |
372 | MUTEX_UNLOCK(&t->mutex); |
14fcddff |
373 | croak("can't detach thread"); |
374 | /* NOTREACHED */ |
734689b1 |
375 | } |
f0f333f4 |
376 | #endif |
d9bb3666 |
377 | |
378 | void |
7d901afa |
379 | equal(t1, t2) |
380 | Thread t1 |
381 | Thread t2 |
382 | PPCODE: |
383 | PUSHs((t1 == t2) ? &sv_yes : &sv_no); |
384 | |
385 | void |
386 | flags(t) |
387 | Thread t |
388 | PPCODE: |
f0f333f4 |
389 | #ifdef USE_THREADS |
7d901afa |
390 | PUSHs(sv_2mortal(newSViv(t->flags))); |
f0f333f4 |
391 | #endif |
7d901afa |
392 | |
393 | void |
458fb581 |
394 | self(classname) |
395 | char * classname |
7d901afa |
396 | PREINIT: |
397 | SV *sv; |
f0f333f4 |
398 | PPCODE: |
399 | #ifdef USE_THREADS |
7d901afa |
400 | sv = newSViv(thr->tid); |
199100c8 |
401 | sv_magic(sv, thr->oursv, '~', 0, 0); |
7d901afa |
402 | SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; |
458fb581 |
403 | PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), |
404 | gv_stashpv(classname, TRUE)))); |
f0f333f4 |
405 | #endif |
7d901afa |
406 | |
50112d62 |
407 | U32 |
408 | tid(t) |
409 | Thread t |
410 | CODE: |
f0f333f4 |
411 | #ifdef USE_THREADS |
50112d62 |
412 | MUTEX_LOCK(&t->mutex); |
413 | RETVAL = t->tid; |
414 | MUTEX_UNLOCK(&t->mutex); |
f0f333f4 |
415 | #else |
416 | RETVAL = 0; |
417 | #endif |
50112d62 |
418 | OUTPUT: |
419 | RETVAL |
420 | |
421 | void |
422 | DESTROY(t) |
423 | SV * t |
424 | PPCODE: |
425 | PUSHs(&sv_yes); |
426 | |
7d901afa |
427 | void |
734689b1 |
428 | yield() |
d9bb3666 |
429 | CODE: |
f0f333f4 |
430 | { |
431 | #ifdef USE_THREADS |
ea0efc06 |
432 | YIELD; |
f0f333f4 |
433 | #endif |
434 | } |
d9bb3666 |
435 | |
436 | void |
734689b1 |
437 | cond_wait(sv) |
438 | SV * sv |
439 | MAGIC * mg = NO_INIT |
f0f333f4 |
440 | CODE: |
441 | #ifdef USE_THREADS |
2c127b02 |
442 | if (SvROK(sv)) |
734689b1 |
443 | sv = SvRV(sv); |
2c127b02 |
444 | |
734689b1 |
445 | mg = condpair_magic(sv); |
683929b4 |
446 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); |
734689b1 |
447 | MUTEX_LOCK(MgMUTEXP(mg)); |
448 | if (MgOWNER(mg) != thr) { |
449 | MUTEX_UNLOCK(MgMUTEXP(mg)); |
450 | croak("cond_wait for lock that we don't own\n"); |
451 | } |
452 | MgOWNER(mg) = 0; |
453 | COND_WAIT(MgCONDP(mg), MgMUTEXP(mg)); |
50112d62 |
454 | while (MgOWNER(mg)) |
455 | COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); |
734689b1 |
456 | MgOWNER(mg) = thr; |
457 | MUTEX_UNLOCK(MgMUTEXP(mg)); |
f0f333f4 |
458 | #endif |
459 | |
734689b1 |
460 | void |
461 | cond_signal(sv) |
462 | SV * sv |
463 | MAGIC * mg = NO_INIT |
464 | CODE: |
f0f333f4 |
465 | #ifdef USE_THREADS |
50112d62 |
466 | if (SvROK(sv)) |
734689b1 |
467 | sv = SvRV(sv); |
50112d62 |
468 | |
734689b1 |
469 | mg = condpair_magic(sv); |
683929b4 |
470 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); |
734689b1 |
471 | MUTEX_LOCK(MgMUTEXP(mg)); |
472 | if (MgOWNER(mg) != thr) { |
473 | MUTEX_UNLOCK(MgMUTEXP(mg)); |
474 | croak("cond_signal for lock that we don't own\n"); |
475 | } |
476 | COND_SIGNAL(MgCONDP(mg)); |
477 | MUTEX_UNLOCK(MgMUTEXP(mg)); |
f0f333f4 |
478 | #endif |
d9bb3666 |
479 | |
734689b1 |
480 | void |
481 | cond_broadcast(sv) |
482 | SV * sv |
483 | MAGIC * mg = NO_INIT |
f0f333f4 |
484 | CODE: |
485 | #ifdef USE_THREADS |
783070da |
486 | if (SvROK(sv)) |
734689b1 |
487 | sv = SvRV(sv); |
783070da |
488 | |
734689b1 |
489 | mg = condpair_magic(sv); |
683929b4 |
490 | DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", |
491 | thr, sv)); |
734689b1 |
492 | MUTEX_LOCK(MgMUTEXP(mg)); |
493 | if (MgOWNER(mg) != thr) { |
494 | MUTEX_UNLOCK(MgMUTEXP(mg)); |
495 | croak("cond_broadcast for lock that we don't own\n"); |
496 | } |
497 | COND_BROADCAST(MgCONDP(mg)); |
498 | MUTEX_UNLOCK(MgMUTEXP(mg)); |
f0f333f4 |
499 | #endif |
f152979c |
500 | |
7d901afa |
501 | void |
458fb581 |
502 | list(classname) |
503 | char * classname |
7d901afa |
504 | PREINIT: |
505 | Thread t; |
506 | AV * av; |
507 | SV ** svp; |
508 | int n = 0; |
509 | PPCODE: |
f0f333f4 |
510 | #ifdef USE_THREADS |
7d901afa |
511 | av = newAV(); |
512 | /* |
513 | * Iterate until we have enough dynamic storage for all threads. |
514 | * We mustn't do any allocation while holding threads_mutex though. |
515 | */ |
516 | MUTEX_LOCK(&threads_mutex); |
517 | do { |
518 | n = nthreads; |
519 | MUTEX_UNLOCK(&threads_mutex); |
520 | if (AvFILL(av) < n - 1) { |
521 | int i = AvFILL(av); |
522 | for (i = AvFILL(av); i < n - 1; i++) { |
523 | SV *sv = newSViv(0); /* fill in tid later */ |
524 | sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */ |
525 | av_push(av, sv_bless(newRV_noinc(sv), |
458fb581 |
526 | gv_stashpv(classname, TRUE))); |
50112d62 |
527 | |
7d901afa |
528 | } |
529 | } |
530 | MUTEX_LOCK(&threads_mutex); |
531 | } while (n < nthreads); |
50112d62 |
532 | n = nthreads; /* Get the final correct value */ |
7d901afa |
533 | |
534 | /* |
535 | * At this point, there's enough room to fill in av. |
536 | * Note that we are holding threads_mutex so the list |
537 | * won't change out from under us but all the remaining |
538 | * processing is "fast" (no blocking, malloc etc.) |
539 | */ |
540 | t = thr; |
541 | svp = AvARRAY(av); |
542 | do { |
0a00ffdb |
543 | SV *sv = (SV*)SvRV(*svp); |
7d901afa |
544 | sv_setiv(sv, t->tid); |
199100c8 |
545 | SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv); |
7d901afa |
546 | SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED; |
547 | SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; |
548 | t = t->next; |
0a00ffdb |
549 | svp++; |
7d901afa |
550 | } while (t != thr); |
50112d62 |
551 | /* */ |
7d901afa |
552 | MUTEX_UNLOCK(&threads_mutex); |
553 | /* Truncate any unneeded slots in av */ |
50112d62 |
554 | av_fill(av, n - 1); |
7d901afa |
555 | /* Finally, push all the new objects onto the stack and drop av */ |
556 | EXTEND(sp, n); |
557 | for (svp = AvARRAY(av); n > 0; n--, svp++) |
558 | PUSHs(*svp); |
559 | (void)sv_2mortal((SV*)av); |
f0f333f4 |
560 | #endif |
7d901afa |
561 | |
562 | |
f152979c |
563 | MODULE = Thread PACKAGE = Thread::Signal |
564 | |
565 | void |
566 | kill_sighandler_thread() |
567 | PPCODE: |
568 | write(sig_pipe[0], "\0", 1); |
569 | PUSHs(&sv_yes); |
570 | |
571 | void |
572 | init_thread_signals() |
573 | PPCODE: |
574 | sighandlerp = handle_thread_signal; |
575 | if (pipe(sig_pipe) == -1) |
576 | XSRETURN_UNDEF; |
577 | PUSHs(&sv_yes); |
578 | |
579 | SV * |
580 | await_signal() |
581 | PREINIT: |
582 | char c; |
ea0efc06 |
583 | SSize_t ret; |
f152979c |
584 | CODE: |
585 | do { |
586 | ret = read(sig_pipe[1], &c, 1); |
587 | } while (ret == -1 && errno == EINTR); |
588 | if (ret == -1) |
589 | croak("panic: await_signal"); |
590 | if (ret == 0) |
591 | XSRETURN_UNDEF; |
592 | RETVAL = c ? psig_ptr[c] : &sv_no; |
593 | OUTPUT: |
594 | RETVAL |
4e35701f |
595 | |
458fb581 |
596 | MODULE = Thread PACKAGE = Thread::Specific |
597 | |
598 | void |
599 | data(classname = "Thread::Specific") |
600 | char * classname |
601 | PPCODE: |
fb223100 |
602 | #ifdef USE_THREADS |
458fb581 |
603 | if (AvFILL(thr->specific) == -1) { |
604 | GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV); |
605 | av_store(thr->specific, 0, newRV((SV*)GvHV(gv))); |
606 | } |
607 | XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE))); |
fb223100 |
608 | #endif |