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