9 Thread thr = (Thread) arg;
12 I32 oldmark = TOPMARK;
13 I32 oldscope = scopestack_ix;
15 AV *returnav = newAV();
19 * Wait until our creator releases us. If we didn't do this, then
20 * it would be potentially possible for out thread to carry on and
21 * do stuff before our creator fills in our "self" field. For example,
22 * if we went and created another thread which tried to pthread_join
23 * with us, then we'd be in a mess.
25 MUTEX_LOCK(threadstart_mutexp);
26 MUTEX_UNLOCK(threadstart_mutexp);
27 MUTEX_DESTROY(threadstart_mutexp); /* don't need it any more */
28 Safefree(threadstart_mutexp);
30 DEBUG_L(fprintf(stderr, "new thread 0x%lx starting at %s\n",
31 (unsigned long) thr, SvPEEK(TOPs)));
33 * It's safe to wait until now to set the thread-specific pointer
34 * from our pthread_t structure to our struct thread, since we're
35 * the only thread who can get at it anyway.
37 if (pthread_setspecific(thr_key, (void *) thr))
38 croak("panic: pthread_setspecific");
40 switch (Sigsetjmp(top_env,1)) {
42 fprintf(stderr, "panic: top_env\n");
52 av_store(returnav, 0, newSViv(statusvalue));
56 /* Now duplicate most of perl_call_sv but with a few twists */
59 myop.op_flags = OPf_STACKED;
60 myop.op_next = Nullop;
61 myop.op_flags |= OPf_KNOW;
62 myop.op_flags |= OPf_LIST;
63 op = pp_entersub(ARGS);
67 retval = sp - (stack_base + oldmark);
68 sp = stack_base + oldmark + 1;
69 av_store(returnav, 0, newSVpv("", 0));
70 for (i = 1; i <= retval; i++, sp++)
71 sv_setsv(*av_fetch(returnav, i, TRUE), SvREFCNT_inc(*sp));
75 SvREFCNT_dec(cvcache);
83 if (ThrSTATE(thr) == THR_DETACHED) {
84 SvREFCNT_dec(returnav);
85 ThrSETSTATE(thr, THR_DEAD);
87 return (void *) returnav; /* Available for anyone to join with us */
88 /* unless we are detached in which case */
89 /* noone will see the value anyway. */
93 newthread(startsv, initargs)
103 New(53, thr, 1, struct thread);
106 defstash = savethread->Tdefstash; /* XXX maybe these should */
107 curstash = savethread->Tcurstash; /* always be set to main? */
112 ThrSETSTATE(thr, THR_NORMAL);
114 /* The following pushes the arg list and startsv onto the *new* stack */
116 /* Could easily speed up the following greatly */
117 for (i = 0; i <= AvFILL(initargs); i++)
118 XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
119 XPUSHs(SvREFCNT_inc(startsv));
122 New(53, threadstart_mutexp, 1, perl_mutex);
123 /* On your marks... */
124 MUTEX_INIT(threadstart_mutexp);
125 MUTEX_LOCK(threadstart_mutexp);
127 * Increment the global thread count. It is decremented
128 * by the destructor for the thread specific key thr_key.
130 MUTEX_LOCK(&nthreads_mutex);
132 MUTEX_UNLOCK(&nthreads_mutex);
133 if (pthread_create(&self, NULL, threadstart, (void*) thr))
134 return NULL; /* XXX should clean up first */
136 MUTEX_UNLOCK(threadstart_mutexp);
146 CV *cv = sv_2cv(sv, &hvp, &gvp, FALSE);
149 croak("Not a CODE reference");
151 COND_DESTROY(CvCONDP(cv));
152 Safefree(CvCONDP(cv));
158 MODULE = Thread PACKAGE = Thread
161 new(class, startsv, ...)
164 AV * av = av_make(items - 2, &ST(2));
166 RETVAL = newthread(startsv, av);
176 SvFLAGS(sv_2cv(sv, &hvp, &gvp, FALSE)) |= SVp_SYNC;
177 ST(0) = sv_mortalcopy(sv);
183 ST(0) = sv_mortalcopy(fast(sv));
191 if (ThrSTATE(t) == THR_DETACHED)
192 croak("tried to join a detached thread");
193 else if (ThrSTATE(t) == THR_JOINED)
194 croak("tried to rejoin an already joined thread");
195 else if (ThrSTATE(t) == THR_DEAD)
196 croak("tried to join a dead thread");
198 if (pthread_join(t->Tself, (void **) &av))
199 croak("pthread_join failed");
200 ThrSETSTATE(t, THR_JOINED);
201 /* Could easily speed up the following if necessary */
202 for (i = 0; i <= AvFILL(av); i++)
203 XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
209 if (ThrSTATE(t) == THR_DETACHED)
210 croak("tried to detach an already detached thread");
211 else if (ThrSTATE(t) == THR_JOINED)
212 croak("tried to detach an already joined thread");
213 else if (ThrSTATE(t) == THR_DEAD)
214 croak("tried to detach a dead thread");
215 if (pthread_detach(t->Tself))
216 croak("pthread_detach failed");
217 ThrSETSTATE(t, THR_DETACHED);
223 if (ThrSTATE(t) == THR_NORMAL) {
224 if (pthread_detach(t->Tself))
225 croak("pthread_detach failed");
226 ThrSETSTATE(t, THR_DETACHED);
232 #ifdef OLD_PTHREADS_API
235 #ifndef NO_SCHED_YIELD
237 #endif /* NO_SCHED_YIELD */
238 #endif /* OLD_PTHREADS_API */
248 mg = condpair_magic(sv);
249 DEBUG_L(fprintf(stderr, "0x%lx: cond_wait 0x%lx\n",
250 (unsigned long)thr, (unsigned long)sv));
251 MUTEX_LOCK(MgMUTEXP(mg));
252 if (MgOWNER(mg) != thr) {
253 MUTEX_UNLOCK(MgMUTEXP(mg));
254 croak("cond_wait for lock that we don't own\n");
257 COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
259 MUTEX_UNLOCK(MgMUTEXP(mg));
268 * Kludge to allow lock of real objects without requiring
269 * to pass in every type of argument by explicit reference.
273 mg = condpair_magic(sv);
274 DEBUG_L(fprintf(stderr, "0x%lx: cond_signal 0x%lx\n",
275 (unsigned long)thr, (unsigned long)sv));
276 MUTEX_LOCK(MgMUTEXP(mg));
277 if (MgOWNER(mg) != thr) {
278 MUTEX_UNLOCK(MgMUTEXP(mg));
279 croak("cond_signal for lock that we don't own\n");
281 COND_SIGNAL(MgCONDP(mg));
282 MUTEX_UNLOCK(MgMUTEXP(mg));
291 * Kludge to allow lock of real objects without requiring
292 * to pass in every type of argument by explicit reference.
296 mg = condpair_magic(sv);
297 DEBUG_L(fprintf(stderr, "0x%lx: cond_broadcast 0x%lx\n",
298 (unsigned long)thr, (unsigned long)sv));
299 MUTEX_LOCK(MgMUTEXP(mg));
300 if (MgOWNER(mg) != thr) {
301 MUTEX_UNLOCK(MgMUTEXP(mg));
302 croak("cond_broadcast for lock that we don't own\n");
304 COND_BROADCAST(MgCONDP(mg));
305 MUTEX_UNLOCK(MgMUTEXP(mg));