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