5 /* Magic signature for Thread's mg_private is "Th" */
6 #define Thread_MAGIC_SIGNATURE 0x5468
15 static U32 threadnum = 0;
16 static int sig_pipe[2];
18 #ifndef THREAD_RET_TYPE
19 typedef struct thread *Thread;
20 #define THREAD_RET_TYPE void *
21 #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
25 remove_thread(struct thread *t)
28 DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(),
29 "%p: remove_thread %p\n", thr, t)));
30 MUTEX_LOCK(&threads_mutex);
31 MUTEX_DESTROY(&t->mutex);
33 t->prev->next = t->next;
34 t->next->prev = t->prev;
35 COND_BROADCAST(&nthreads_cond);
36 MUTEX_UNLOCK(&threads_mutex);
40 static THREAD_RET_TYPE
41 threadstart(void *arg)
45 Thread savethread = thr;
48 I32 oldscope = scopestack_ix;
53 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
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;
64 /* Now duplicate most of perl_call_sv but with a few twists */
67 myop.op_flags = OPf_STACKED;
68 myop.op_next = Nullop;
69 myop.op_flags |= OPf_KNOW;
70 myop.op_flags |= OPf_WANT_LIST;
71 op = pp_entersub(ARGS);
73 PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n"));
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.
80 thr = savethread; /* back to the old thread */
83 Thread thr = (Thread) arg;
86 I32 oldmark = TOPMARK;
87 I32 oldscope = scopestack_ix;
93 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n",
96 /* Don't call *anything* requiring dTHR until after SET_THR() */
98 * Wait until our creator releases us. If we didn't do this, then
99 * it would be potentially possible for out thread to carry on and
100 * do stuff before our creator fills in our "self" field. For example,
101 * if we went and created another thread which tried to JOIN with us,
102 * then we'd be in a mess.
104 MUTEX_LOCK(&thr->mutex);
105 MUTEX_UNLOCK(&thr->mutex);
108 * It's safe to wait until now to set the thread-specific pointer
109 * from our pthread_t structure to our struct thread, since we're
110 * the only thread who can get at it anyway.
114 /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */
115 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n",
122 PerlIO_printf(PerlIO_stderr(), "panic: threadstart\n");
128 /* my_exit() was called */
129 while (scopestack_ix > oldscope)
132 MUTEX_LOCK(&thr->mutex);
133 thr->flags |= THRf_DID_DIE;
134 MUTEX_UNLOCK(&thr->mutex);
135 av = newSVpvf("Thread called exit with value %d", statusvalue);
141 /* Now duplicate most of perl_call_sv but with a few twists */
144 myop.op_flags = OPf_STACKED;
145 myop.op_next = Nullop;
146 myop.op_flags |= OPf_KNOW;
147 myop.op_flags |= OPf_WANT_LIST;
148 op = pp_entersub(ARGS);
154 perl_call_sv(sv, G_ARRAY|G_EVAL);
157 retval = sp - (stack_base + oldmark);
158 sp = stack_base + oldmark + 1;
159 if (SvCUR(thr->errsv)) {
160 MUTEX_LOCK(&thr->mutex);
161 thr->flags |= THRf_DID_DIE;
162 MUTEX_UNLOCK(&thr->mutex);
163 av_store(av, 0, &sv_no);
164 av_store(av, 1, newSVsv(thr->errsv));
165 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
166 SvPV(thr->errsv, na));
169 for (i = 1; i <= retval; i++) {
170 PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n",
171 thr, i, SvPEEK(sp[i - 1]));)
174 av_store(av, 0, &sv_yes);
175 for (i = 1; i <= retval; i++, sp++)
176 sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*sp));
181 /* removed for debug */
182 SvREFCNT_dec(curstack);
184 SvREFCNT_dec(thr->cvcache);
185 SvREFCNT_dec(thr->magicals);
186 SvREFCNT_dec(thr->specific);
187 SvREFCNT_dec(thr->errsv);
188 SvREFCNT_dec(thr->errhv);
190 Safefree(scopestack);
194 Safefree(tmps_stack);
197 MUTEX_LOCK(&thr->mutex);
198 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
199 "%p: threadstart finishing: state is %u\n",
200 thr, ThrSTATE(thr)));
201 switch (ThrSTATE(thr)) {
202 case THRf_R_JOINABLE:
203 ThrSETSTATE(thr, THRf_ZOMBIE);
204 MUTEX_UNLOCK(&thr->mutex);
205 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
206 "%p: R_JOINABLE thread finished\n", thr));
209 ThrSETSTATE(thr, THRf_DEAD);
210 MUTEX_UNLOCK(&thr->mutex);
212 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
213 "%p: R_JOINED thread finished\n", thr));
215 case THRf_R_DETACHED:
216 ThrSETSTATE(thr, THRf_DEAD);
217 MUTEX_UNLOCK(&thr->mutex);
219 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
220 "%p: DETACHED thread finished\n", thr));
221 remove_thread(thr); /* This might trigger main thread to finish */
224 MUTEX_UNLOCK(&thr->mutex);
225 croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr));
228 return THREAD_RET_CAST(av); /* Available for anyone to join with */
229 /* us unless we're detached, in which */
230 /* case noone sees the value anyway. */
233 return THREAD_RET_CAST(NULL);
238 newthread (SV *startsv, AV *initargs, char *classname)
246 #ifndef THREAD_CREATE
247 sigset_t fullmask, oldmask;
251 thr = new_struct_thread(thr);
253 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
254 "%p: newthread (%p), tid is %u, preparing stack\n",
255 savethread, thr, thr->tid));
256 /* The following pushes the arg list and startsv onto the *new* stack */
258 /* Could easily speed up the following greatly */
259 for (i = 0; i <= AvFILL(initargs); i++)
260 XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
261 XPUSHs(SvREFCNT_inc(startsv));
264 err = THREAD_CREATE(thr, threadstart);
266 /* On your marks... */
267 MUTEX_LOCK(&thr->mutex);
269 sigfillset(&fullmask);
270 if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
271 croak("panic: sigprocmask");
272 err = pthread_create(&thr->self, pthread_attr_default,
273 threadstart, (void*) thr);
275 MUTEX_UNLOCK(&thr->mutex);
278 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
279 "%p: create of %p failed %d\n", savethread, thr, err));
280 /* Thread creation failed--clean up */
281 SvREFCNT_dec(thr->cvcache);
283 MUTEX_DESTROY(&thr->mutex);
284 for (i = 0; i <= AvFILL(initargs); i++)
285 SvREFCNT_dec(*av_fetch(initargs, i, FALSE));
286 SvREFCNT_dec(startsv);
289 #ifdef THREAD_POST_CREATE
290 THREAD_POST_CREATE(thr);
292 if (sigprocmask(SIG_SETMASK, &oldmask, 0))
293 croak("panic: sigprocmask");
295 sv = newSViv(thr->tid);
296 sv_magic(sv, thr->oursv, '~', 0, 0);
297 SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
298 return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
300 croak("No threads in this perl");
305 static Signal_t handle_thread_signal _((int sig));
308 handle_thread_signal(int sig)
311 write(sig_pipe[0], &c, 1);
314 MODULE = Thread PACKAGE = Thread
318 new(classname, startsv, ...)
321 AV * av = av_make(items - 2, &ST(2));
323 XPUSHs(sv_2mortal(newthread(startsv, av, classname)));
332 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n",
333 thr, t, ThrSTATE(t)););
334 MUTEX_LOCK(&t->mutex);
335 switch (ThrSTATE(t)) {
336 case THRf_R_JOINABLE:
338 ThrSETSTATE(t, THRf_R_JOINED);
339 MUTEX_UNLOCK(&t->mutex);
342 ThrSETSTATE(t, THRf_DEAD);
343 MUTEX_UNLOCK(&t->mutex);
347 MUTEX_UNLOCK(&t->mutex);
348 croak("can't join with thread");
353 if (SvTRUE(*av_fetch(av, 0, FALSE))) {
354 /* Could easily speed up the following if necessary */
355 for (i = 1; i <= AvFILL(av); i++)
356 XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
358 char *mess = SvPV(*av_fetch(av, 1, FALSE), na);
359 DEBUG_L(PerlIO_printf(PerlIO_stderr(),
360 "%p: join propagating die message: %s\n",
371 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n",
372 thr, t, ThrSTATE(t)););
373 MUTEX_LOCK(&t->mutex);
374 switch (ThrSTATE(t)) {
375 case THRf_R_JOINABLE:
376 ThrSETSTATE(t, THRf_R_DETACHED);
378 case THRf_R_DETACHED:
380 MUTEX_UNLOCK(&t->mutex);
383 ThrSETSTATE(t, THRf_DEAD);
385 MUTEX_UNLOCK(&t->mutex);
389 MUTEX_UNLOCK(&t->mutex);
390 croak("can't detach thread");
400 PUSHs((t1 == t2) ? &sv_yes : &sv_no);
407 PUSHs(sv_2mortal(newSViv(t->flags)));
417 sv = newSViv(thr->tid);
418 sv_magic(sv, thr->oursv, '~', 0, 0);
419 SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
420 PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv),
421 gv_stashpv(classname, TRUE))));
429 MUTEX_LOCK(&t->mutex);
431 MUTEX_UNLOCK(&t->mutex);
462 mg = condpair_magic(sv);
463 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv));
464 MUTEX_LOCK(MgMUTEXP(mg));
465 if (MgOWNER(mg) != thr) {
466 MUTEX_UNLOCK(MgMUTEXP(mg));
467 croak("cond_wait for lock that we don't own\n");
470 COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
472 COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
474 MUTEX_UNLOCK(MgMUTEXP(mg));
486 mg = condpair_magic(sv);
487 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv));
488 MUTEX_LOCK(MgMUTEXP(mg));
489 if (MgOWNER(mg) != thr) {
490 MUTEX_UNLOCK(MgMUTEXP(mg));
491 croak("cond_signal for lock that we don't own\n");
493 COND_SIGNAL(MgCONDP(mg));
494 MUTEX_UNLOCK(MgMUTEXP(mg));
506 mg = condpair_magic(sv);
507 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n",
509 MUTEX_LOCK(MgMUTEXP(mg));
510 if (MgOWNER(mg) != thr) {
511 MUTEX_UNLOCK(MgMUTEXP(mg));
512 croak("cond_broadcast for lock that we don't own\n");
514 COND_BROADCAST(MgCONDP(mg));
515 MUTEX_UNLOCK(MgMUTEXP(mg));
530 * Iterate until we have enough dynamic storage for all threads.
531 * We mustn't do any allocation while holding threads_mutex though.
533 MUTEX_LOCK(&threads_mutex);
536 MUTEX_UNLOCK(&threads_mutex);
537 if (AvFILL(av) < n - 1) {
539 for (i = AvFILL(av); i < n - 1; i++) {
540 SV *sv = newSViv(0); /* fill in tid later */
541 sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */
542 av_push(av, sv_bless(newRV_noinc(sv),
543 gv_stashpv(classname, TRUE)));
547 MUTEX_LOCK(&threads_mutex);
548 } while (n < nthreads);
549 n = nthreads; /* Get the final correct value */
552 * At this point, there's enough room to fill in av.
553 * Note that we are holding threads_mutex so the list
554 * won't change out from under us but all the remaining
555 * processing is "fast" (no blocking, malloc etc.)
560 SV *sv = (SV*)SvRV(*svp);
561 sv_setiv(sv, t->tid);
562 SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv);
563 SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED;
564 SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
569 MUTEX_UNLOCK(&threads_mutex);
570 /* Truncate any unneeded slots in av */
572 /* Finally, push all the new objects onto the stack and drop av */
574 for (svp = AvARRAY(av); n > 0; n--, svp++)
576 (void)sv_2mortal((SV*)av);
580 MODULE = Thread PACKAGE = Thread::Signal
583 kill_sighandler_thread()
585 write(sig_pipe[0], "\0", 1);
589 init_thread_signals()
591 sighandlerp = handle_thread_signal;
592 if (pipe(sig_pipe) == -1)
603 ret = read(sig_pipe[1], &c, 1);
604 } while (ret == -1 && errno == EINTR);
606 croak("panic: await_signal");
609 RETVAL = c ? psig_ptr[c] : &sv_no;
613 MODULE = Thread PACKAGE = Thread::Specific
616 data(classname = "Thread::Specific")
619 if (AvFILL(thr->specific) == -1) {
620 GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV);
621 av_store(thr->specific, 0, newRV((SV*)GvHV(gv)));
623 XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE)));