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