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 | ||
85ced67f | 15 | static int sig_pipe[2]; |
f0f333f4 NIS |
16 | |
17 | #ifndef THREAD_RET_TYPE | |
f0f333f4 NIS |
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 MB |
31 | t->prev->next = t->next; |
32 | t->next->prev = t->prev; | |
533c011a NIS |
33 | COND_BROADCAST(&PL_nthreads_cond); |
34 | MUTEX_UNLOCK(&PL_threads_mutex); | |
f0f333f4 | 35 | #endif |
7d901afa MB |
36 | } |
37 | ||
ea0efc06 | 38 | static THREAD_RET_TYPE |
f0f333f4 | 39 | threadstart(void *arg) |
d9bb3666 | 40 | { |
f0f333f4 | 41 | #ifdef USE_THREADS |
783070da MB |
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 MB |
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 MB |
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 GS |
63 | PL_op = (OP*)&myop; |
64 | Zero(PL_op, 1, LOGOP); | |
783070da MB |
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 MB |
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 MB |
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 MB |
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 MB |
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 MB |
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 MB |
102 | MUTEX_LOCK(&thr->mutex); |
103 | MUTEX_UNLOCK(&thr->mutex); | |
d9bb3666 | 104 | |
d9bb3666 MB |
105 | /* |
106 | * It's safe to wait until now to set the thread-specific pointer | |
52e1cb5e JH |
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 MB |
116 | sv = POPs; |
117 | PUTBACK; | |
118 | perl_call_sv(sv, G_ARRAY|G_EVAL); | |
734689b1 | 119 | SPAGAIN; |
533c011a NIS |
120 | retval = SP - (PL_stack_base + oldmark); |
121 | SP = PL_stack_base + oldmark + 1; | |
458fb581 MB |
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 MB |
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 MB |
135 | } |
136 | } STMT_END); | |
6b88bc9c | 137 | av_store(av, 0, &PL_sv_yes); |
924508f0 GS |
138 | for (i = 1; i <= retval; i++, SP++) |
139 | sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP)); | |
458fb581 MB |
140 | } |
141 | ||
d9bb3666 | 142 | finishoff: |
783070da MB |
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 MB |
150 | SvREFCNT_dec(thr->errsv); |
151 | SvREFCNT_dec(thr->errhv); | |
5c0ca799 | 152 | |
f7ac0805 | 153 | /*Safefree(cxstack);*/ |
84fee439 NIS |
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 NIS |
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 NIS |
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 MB |
181 | "%p: threadstart finishing: state is %u\n", |
182 | thr, ThrSTATE(thr))); | |
14fcddff MB |
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 MB |
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 MB |
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 MB |
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 MB |
211 | /* us unless we're detached, in which */ |
212 | /* case noone sees the value anyway. */ | |
783070da | 213 | #endif |
f0f333f4 NIS |
214 | #else |
215 | return THREAD_RET_CAST(NULL); | |
216 | #endif | |
d9bb3666 MB |
217 | } |
218 | ||
683929b4 | 219 | static SV * |
458fb581 | 220 | newthread (SV *startsv, AV *initargs, char *classname) |
d9bb3666 | 221 | { |
f0f333f4 | 222 | #ifdef USE_THREADS |
d9bb3666 MB |
223 | dSP; |
224 | Thread savethread; | |
225 | int i; | |
683929b4 | 226 | SV *sv; |
ea0efc06 MB |
227 | int err; |
228 | #ifndef THREAD_CREATE | |
940cb80d MB |
229 | static pthread_attr_t attr; |
230 | static int attr_inited = 0; | |
f152979c | 231 | sigset_t fullmask, oldmask; |
ea0efc06 | 232 | #endif |
1cfa4ec7 GS |
233 | #ifdef PTHREAD_SETDETACHSTATE_ARG2_POINTER |
234 | static int attr_joinable = ATTR_JOINABLE; | |
235 | #endif | |
236 | ||
d9bb3666 | 237 | savethread = thr; |
a863c7d1 | 238 | thr = new_struct_thread(thr); |
d9bb3666 | 239 | SPAGAIN; |
8b73bbec | 240 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), |
0b9678a8 NIS |
241 | "%p: newthread (%p), tid is %u, preparing stack\n", |
242 | savethread, thr, thr->tid)); | |
d9bb3666 | 243 | /* The following pushes the arg list and startsv onto the *new* stack */ |
924508f0 | 244 | PUSHMARK(SP); |
d9bb3666 | 245 | /* Could easily speed up the following greatly */ |
734689b1 | 246 | for (i = 0; i <= AvFILL(initargs); i++) |
d9bb3666 MB |
247 | XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); |
248 | XPUSHs(SvREFCNT_inc(startsv)); | |
249 | PUTBACK; | |
ea0efc06 | 250 | #ifdef THREAD_CREATE |
f0f333f4 | 251 | err = THREAD_CREATE(thr, threadstart); |
783070da | 252 | #else |
d9bb3666 | 253 | /* On your marks... */ |
14fcddff | 254 | MUTEX_LOCK(&thr->mutex); |
ea0efc06 | 255 | /* Get set... */ |
f152979c MB |
256 | sigfillset(&fullmask); |
257 | if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) | |
258 | croak("panic: sigprocmask"); | |
940cb80d MB |
259 | err = 0; |
260 | if (!attr_inited) { | |
261 | attr_inited = 1; | |
9ef4b0a6 BH |
262 | #ifdef OLD_PTHREADS_API |
263 | err = pthread_attr_create(&attr); | |
264 | #else | |
52e1cb5e | 265 | err = pthread_attr_init(&attr); |
9ef4b0a6 BH |
266 | #endif |
267 | #ifdef OLD_PTHREADS_API | |
268 | #ifdef VMS | |
269 | /* This is available with the old pthreads API, but only with */ | |
1cfa4ec7 | 270 | /* DecThreads (VMS and Digital Unix (which has and uses the new one)) */ |
9ef4b0a6 BH |
271 | if (err == 0) |
272 | err = pthread_attr_setdetach_np(&attr, ATTR_JOINABLE); | |
273 | #endif | |
1cfa4ec7 GS |
274 | #else /* !defined(VMS) */ |
275 | #ifdef ATTR_JOINABLE | |
940cb80d MB |
276 | if (err == 0) |
277 | err = pthread_attr_setdetachstate(&attr, ATTR_JOINABLE); | |
1cfa4ec7 GS |
278 | #else /* !defined(ATTR_JOINABLE) */ |
279 | #ifdef __UNDETACHED | |
280 | if (err == 0) | |
281 | err = pthread_attr_setdetachstate(&attr, &__undetached); | |
282 | #else /* !defined(__UNDETACHED) */ | |
283 | croak("panic: can't pthread_attr_setdetachstate"); | |
284 | #endif /* __UNDETACHED */ | |
285 | #endif /* ATTR_JOINABLE */ | |
286 | #endif /* VMS */ | |
287 | #endif /* OLD_PTHREADS_API */ | |
52e1cb5e | 288 | } |
940cb80d | 289 | if (err == 0) |
9ef4b0a6 BH |
290 | #ifdef OLD_PTHREADS_API |
291 | err = pthread_create(&thr->self, attr, threadstart, (void*) thr); | |
292 | #else | |
940cb80d | 293 | err = pthread_create(&thr->self, &attr, threadstart, (void*) thr); |
9ef4b0a6 | 294 | #endif |
d9bb3666 | 295 | /* Go */ |
14fcddff | 296 | MUTEX_UNLOCK(&thr->mutex); |
ea0efc06 MB |
297 | #endif |
298 | if (err) { | |
8b73bbec | 299 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), |
940cb80d MB |
300 | "%p: create of %p failed %d\n", |
301 | savethread, thr, err)); | |
ea0efc06 | 302 | /* Thread creation failed--clean up */ |
199100c8 | 303 | SvREFCNT_dec(thr->cvcache); |
ea0efc06 MB |
304 | remove_thread(thr); |
305 | MUTEX_DESTROY(&thr->mutex); | |
306 | for (i = 0; i <= AvFILL(initargs); i++) | |
307 | SvREFCNT_dec(*av_fetch(initargs, i, FALSE)); | |
308 | SvREFCNT_dec(startsv); | |
309 | return NULL; | |
310 | } | |
311 | #ifdef THREAD_POST_CREATE | |
312 | THREAD_POST_CREATE(thr); | |
313 | #else | |
f152979c MB |
314 | if (sigprocmask(SIG_SETMASK, &oldmask, 0)) |
315 | croak("panic: sigprocmask"); | |
783070da | 316 | #endif |
7d901afa | 317 | sv = newSViv(thr->tid); |
199100c8 | 318 | sv_magic(sv, thr->oursv, '~', 0, 0); |
7d901afa | 319 | SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; |
458fb581 | 320 | return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); |
f0f333f4 NIS |
321 | #else |
322 | croak("No threads in this perl"); | |
6b88bc9c | 323 | return &PL_sv_undef; |
f0f333f4 | 324 | #endif |
d9bb3666 MB |
325 | } |
326 | ||
f0f333f4 NIS |
327 | static Signal_t handle_thread_signal _((int sig)); |
328 | ||
f152979c | 329 | static Signal_t |
f0f333f4 | 330 | handle_thread_signal(int sig) |
f152979c | 331 | { |
3aeed370 MB |
332 | unsigned char c = (unsigned char) sig; |
333 | /* | |
334 | * We're not really allowed to call fprintf in a signal handler | |
335 | * so don't be surprised if this isn't robust while debugging | |
336 | * with -DL. | |
337 | */ | |
8b73bbec | 338 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), |
3aeed370 MB |
339 | "handle_thread_signal: got signal %d\n", sig);); |
340 | write(sig_pipe[1], &c, 1); | |
f152979c MB |
341 | } |
342 | ||
d9bb3666 | 343 | MODULE = Thread PACKAGE = Thread |
0b9678a8 | 344 | PROTOTYPES: DISABLE |
d9bb3666 | 345 | |
683929b4 | 346 | void |
458fb581 MB |
347 | new(classname, startsv, ...) |
348 | char * classname | |
d9bb3666 | 349 | SV * startsv |
734689b1 | 350 | AV * av = av_make(items - 2, &ST(2)); |
683929b4 | 351 | PPCODE: |
458fb581 | 352 | XPUSHs(sv_2mortal(newthread(startsv, av, classname))); |
d9bb3666 MB |
353 | |
354 | void | |
d9bb3666 MB |
355 | join(t) |
356 | Thread t | |
357 | AV * av = NO_INIT | |
358 | int i = NO_INIT | |
359 | PPCODE: | |
f0f333f4 | 360 | #ifdef USE_THREADS |
8b73bbec | 361 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", |
7d901afa | 362 | thr, t, ThrSTATE(t));); |
50112d62 MB |
363 | MUTEX_LOCK(&t->mutex); |
364 | switch (ThrSTATE(t)) { | |
14fcddff MB |
365 | case THRf_R_JOINABLE: |
366 | case THRf_R_JOINED: | |
50112d62 MB |
367 | ThrSETSTATE(t, THRf_R_JOINED); |
368 | MUTEX_UNLOCK(&t->mutex); | |
14fcddff MB |
369 | break; |
370 | case THRf_ZOMBIE: | |
50112d62 MB |
371 | ThrSETSTATE(t, THRf_DEAD); |
372 | MUTEX_UNLOCK(&t->mutex); | |
373 | remove_thread(t); | |
14fcddff MB |
374 | break; |
375 | default: | |
50112d62 | 376 | MUTEX_UNLOCK(&t->mutex); |
14fcddff MB |
377 | croak("can't join with thread"); |
378 | /* NOTREACHED */ | |
379 | } | |
ea0efc06 | 380 | JOIN(t, &av); |
7d901afa | 381 | |
458fb581 MB |
382 | if (SvTRUE(*av_fetch(av, 0, FALSE))) { |
383 | /* Could easily speed up the following if necessary */ | |
384 | for (i = 1; i <= AvFILL(av); i++) | |
385 | XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); | |
386 | } else { | |
6b88bc9c | 387 | char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na); |
8b73bbec | 388 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), |
458fb581 MB |
389 | "%p: join propagating die message: %s\n", |
390 | thr, mess)); | |
391 | croak(mess); | |
392 | } | |
f0f333f4 | 393 | #endif |
d9bb3666 MB |
394 | |
395 | void | |
734689b1 | 396 | detach(t) |
d9bb3666 MB |
397 | Thread t |
398 | CODE: | |
f0f333f4 | 399 | #ifdef USE_THREADS |
8b73bbec | 400 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", |
7d901afa | 401 | thr, t, ThrSTATE(t));); |
50112d62 MB |
402 | MUTEX_LOCK(&t->mutex); |
403 | switch (ThrSTATE(t)) { | |
14fcddff | 404 | case THRf_R_JOINABLE: |
50112d62 | 405 | ThrSETSTATE(t, THRf_R_DETACHED); |
14fcddff | 406 | /* fall through */ |
50112d62 | 407 | case THRf_R_DETACHED: |
14fcddff | 408 | DETACH(t); |
50112d62 | 409 | MUTEX_UNLOCK(&t->mutex); |
14fcddff MB |
410 | break; |
411 | case THRf_ZOMBIE: | |
50112d62 | 412 | ThrSETSTATE(t, THRf_DEAD); |
7d901afa | 413 | DETACH(t); |
50112d62 MB |
414 | MUTEX_UNLOCK(&t->mutex); |
415 | remove_thread(t); | |
14fcddff MB |
416 | break; |
417 | default: | |
50112d62 | 418 | MUTEX_UNLOCK(&t->mutex); |
14fcddff MB |
419 | croak("can't detach thread"); |
420 | /* NOTREACHED */ | |
734689b1 | 421 | } |
f0f333f4 | 422 | #endif |
d9bb3666 MB |
423 | |
424 | void | |
7d901afa MB |
425 | equal(t1, t2) |
426 | Thread t1 | |
427 | Thread t2 | |
428 | PPCODE: | |
6b88bc9c | 429 | PUSHs((t1 == t2) ? &PL_sv_yes : &PL_sv_no); |
7d901afa MB |
430 | |
431 | void | |
432 | flags(t) | |
433 | Thread t | |
434 | PPCODE: | |
f0f333f4 | 435 | #ifdef USE_THREADS |
7d901afa | 436 | PUSHs(sv_2mortal(newSViv(t->flags))); |
f0f333f4 | 437 | #endif |
7d901afa MB |
438 | |
439 | void | |
458fb581 MB |
440 | self(classname) |
441 | char * classname | |
7d901afa MB |
442 | PREINIT: |
443 | SV *sv; | |
f0f333f4 NIS |
444 | PPCODE: |
445 | #ifdef USE_THREADS | |
7d901afa | 446 | sv = newSViv(thr->tid); |
199100c8 | 447 | sv_magic(sv, thr->oursv, '~', 0, 0); |
7d901afa | 448 | SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; |
458fb581 MB |
449 | PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), |
450 | gv_stashpv(classname, TRUE)))); | |
f0f333f4 | 451 | #endif |
7d901afa | 452 | |
50112d62 MB |
453 | U32 |
454 | tid(t) | |
455 | Thread t | |
456 | CODE: | |
f0f333f4 | 457 | #ifdef USE_THREADS |
50112d62 MB |
458 | MUTEX_LOCK(&t->mutex); |
459 | RETVAL = t->tid; | |
460 | MUTEX_UNLOCK(&t->mutex); | |
f0f333f4 NIS |
461 | #else |
462 | RETVAL = 0; | |
463 | #endif | |
50112d62 MB |
464 | OUTPUT: |
465 | RETVAL | |
466 | ||
467 | void | |
468 | DESTROY(t) | |
469 | SV * t | |
470 | PPCODE: | |
6b88bc9c | 471 | PUSHs(&PL_sv_yes); |
50112d62 | 472 | |
7d901afa | 473 | void |
734689b1 | 474 | yield() |
d9bb3666 | 475 | CODE: |
f0f333f4 NIS |
476 | { |
477 | #ifdef USE_THREADS | |
ea0efc06 | 478 | YIELD; |
f0f333f4 NIS |
479 | #endif |
480 | } | |
d9bb3666 MB |
481 | |
482 | void | |
734689b1 MB |
483 | cond_wait(sv) |
484 | SV * sv | |
485 | MAGIC * mg = NO_INIT | |
f0f333f4 NIS |
486 | CODE: |
487 | #ifdef USE_THREADS | |
2c127b02 | 488 | if (SvROK(sv)) |
734689b1 | 489 | sv = SvRV(sv); |
2c127b02 | 490 | |
734689b1 | 491 | mg = condpair_magic(sv); |
8b73bbec | 492 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); |
734689b1 MB |
493 | MUTEX_LOCK(MgMUTEXP(mg)); |
494 | if (MgOWNER(mg) != thr) { | |
495 | MUTEX_UNLOCK(MgMUTEXP(mg)); | |
496 | croak("cond_wait for lock that we don't own\n"); | |
497 | } | |
498 | MgOWNER(mg) = 0; | |
d3ef5668 | 499 | COND_SIGNAL(MgOWNERCONDP(mg)); |
734689b1 | 500 | COND_WAIT(MgCONDP(mg), MgMUTEXP(mg)); |
50112d62 MB |
501 | while (MgOWNER(mg)) |
502 | COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); | |
734689b1 MB |
503 | MgOWNER(mg) = thr; |
504 | MUTEX_UNLOCK(MgMUTEXP(mg)); | |
f0f333f4 NIS |
505 | #endif |
506 | ||
734689b1 MB |
507 | void |
508 | cond_signal(sv) | |
509 | SV * sv | |
510 | MAGIC * mg = NO_INIT | |
511 | CODE: | |
f0f333f4 | 512 | #ifdef USE_THREADS |
50112d62 | 513 | if (SvROK(sv)) |
734689b1 | 514 | sv = SvRV(sv); |
50112d62 | 515 | |
734689b1 | 516 | mg = condpair_magic(sv); |
8b73bbec | 517 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); |
734689b1 MB |
518 | MUTEX_LOCK(MgMUTEXP(mg)); |
519 | if (MgOWNER(mg) != thr) { | |
520 | MUTEX_UNLOCK(MgMUTEXP(mg)); | |
521 | croak("cond_signal for lock that we don't own\n"); | |
522 | } | |
523 | COND_SIGNAL(MgCONDP(mg)); | |
524 | MUTEX_UNLOCK(MgMUTEXP(mg)); | |
f0f333f4 | 525 | #endif |
d9bb3666 | 526 | |
734689b1 MB |
527 | void |
528 | cond_broadcast(sv) | |
529 | SV * sv | |
530 | MAGIC * mg = NO_INIT | |
f0f333f4 NIS |
531 | CODE: |
532 | #ifdef USE_THREADS | |
783070da | 533 | if (SvROK(sv)) |
734689b1 | 534 | sv = SvRV(sv); |
783070da | 535 | |
734689b1 | 536 | mg = condpair_magic(sv); |
8b73bbec | 537 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", |
683929b4 | 538 | thr, sv)); |
734689b1 MB |
539 | MUTEX_LOCK(MgMUTEXP(mg)); |
540 | if (MgOWNER(mg) != thr) { | |
541 | MUTEX_UNLOCK(MgMUTEXP(mg)); | |
542 | croak("cond_broadcast for lock that we don't own\n"); | |
543 | } | |
544 | COND_BROADCAST(MgCONDP(mg)); | |
545 | MUTEX_UNLOCK(MgMUTEXP(mg)); | |
f0f333f4 | 546 | #endif |
f152979c | 547 | |
7d901afa | 548 | void |
458fb581 MB |
549 | list(classname) |
550 | char * classname | |
7d901afa MB |
551 | PREINIT: |
552 | Thread t; | |
553 | AV * av; | |
554 | SV ** svp; | |
555 | int n = 0; | |
556 | PPCODE: | |
f0f333f4 | 557 | #ifdef USE_THREADS |
7d901afa MB |
558 | av = newAV(); |
559 | /* | |
560 | * Iterate until we have enough dynamic storage for all threads. | |
561 | * We mustn't do any allocation while holding threads_mutex though. | |
562 | */ | |
533c011a | 563 | MUTEX_LOCK(&PL_threads_mutex); |
7d901afa | 564 | do { |
533c011a NIS |
565 | n = PL_nthreads; |
566 | MUTEX_UNLOCK(&PL_threads_mutex); | |
7d901afa MB |
567 | if (AvFILL(av) < n - 1) { |
568 | int i = AvFILL(av); | |
569 | for (i = AvFILL(av); i < n - 1; i++) { | |
570 | SV *sv = newSViv(0); /* fill in tid later */ | |
571 | sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */ | |
572 | av_push(av, sv_bless(newRV_noinc(sv), | |
458fb581 | 573 | gv_stashpv(classname, TRUE))); |
50112d62 | 574 | |
7d901afa MB |
575 | } |
576 | } | |
533c011a NIS |
577 | MUTEX_LOCK(&PL_threads_mutex); |
578 | } while (n < PL_nthreads); | |
579 | n = PL_nthreads; /* Get the final correct value */ | |
7d901afa MB |
580 | |
581 | /* | |
582 | * At this point, there's enough room to fill in av. | |
583 | * Note that we are holding threads_mutex so the list | |
584 | * won't change out from under us but all the remaining | |
585 | * processing is "fast" (no blocking, malloc etc.) | |
586 | */ | |
587 | t = thr; | |
588 | svp = AvARRAY(av); | |
589 | do { | |
0a00ffdb | 590 | SV *sv = (SV*)SvRV(*svp); |
7d901afa | 591 | sv_setiv(sv, t->tid); |
199100c8 | 592 | SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv); |
7d901afa MB |
593 | SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED; |
594 | SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; | |
595 | t = t->next; | |
0a00ffdb | 596 | svp++; |
7d901afa | 597 | } while (t != thr); |
50112d62 | 598 | /* */ |
533c011a | 599 | MUTEX_UNLOCK(&PL_threads_mutex); |
7d901afa | 600 | /* Truncate any unneeded slots in av */ |
50112d62 | 601 | av_fill(av, n - 1); |
7d901afa | 602 | /* Finally, push all the new objects onto the stack and drop av */ |
924508f0 | 603 | EXTEND(SP, n); |
7d901afa MB |
604 | for (svp = AvARRAY(av); n > 0; n--, svp++) |
605 | PUSHs(*svp); | |
606 | (void)sv_2mortal((SV*)av); | |
f0f333f4 | 607 | #endif |
7d901afa MB |
608 | |
609 | ||
f152979c MB |
610 | MODULE = Thread PACKAGE = Thread::Signal |
611 | ||
612 | void | |
613 | kill_sighandler_thread() | |
614 | PPCODE: | |
3aeed370 | 615 | write(sig_pipe[1], "\0", 1); |
6b88bc9c | 616 | PUSHs(&PL_sv_yes); |
f152979c MB |
617 | |
618 | void | |
619 | init_thread_signals() | |
620 | PPCODE: | |
533c011a | 621 | PL_sighandlerp = handle_thread_signal; |
f152979c MB |
622 | if (pipe(sig_pipe) == -1) |
623 | XSRETURN_UNDEF; | |
6b88bc9c | 624 | PUSHs(&PL_sv_yes); |
f152979c | 625 | |
3aeed370 | 626 | void |
f152979c MB |
627 | await_signal() |
628 | PREINIT: | |
3aeed370 | 629 | unsigned char c; |
ea0efc06 | 630 | SSize_t ret; |
f152979c MB |
631 | CODE: |
632 | do { | |
3aeed370 | 633 | ret = read(sig_pipe[0], &c, 1); |
f152979c MB |
634 | } while (ret == -1 && errno == EINTR); |
635 | if (ret == -1) | |
636 | croak("panic: await_signal"); | |
3aeed370 MB |
637 | ST(0) = sv_newmortal(); |
638 | if (ret) | |
6b88bc9c | 639 | sv_setsv(ST(0), c ? psig_ptr[c] : &PL_sv_no); |
8b73bbec | 640 | DEBUG_S(PerlIO_printf(PerlIO_stderr(), |
3aeed370 | 641 | "await_signal returning %s\n", SvPEEK(ST(0)));); |
4e35701f | 642 | |
458fb581 MB |
643 | MODULE = Thread PACKAGE = Thread::Specific |
644 | ||
645 | void | |
646 | data(classname = "Thread::Specific") | |
647 | char * classname | |
648 | PPCODE: | |
fb223100 | 649 | #ifdef USE_THREADS |
458fb581 MB |
650 | if (AvFILL(thr->specific) == -1) { |
651 | GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV); | |
652 | av_store(thr->specific, 0, newRV((SV*)GvHV(gv))); | |
653 | } | |
654 | XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE))); | |
fb223100 | 655 | #endif |