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