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