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