From 458fb5819c1ac395635ee1129f0f694cb0128ffd Mon Sep 17 00:00:00 2001 From: Malcolm Beattie Date: Thu, 13 Nov 1997 18:01:27 +0000 Subject: Rewrite thread return code to distinguish between ordinary return and die() and make join propagate the die. Add tiny method eval which just does "return eval { shift->join; }". Add Thread::Specific class for access to thread specific user data along with specific.t. Rename Class to classname throughout Thread.xs for consistency. Fix pp_specific to pp_threadsv in global.sym. Add support to pp_entersub in pp_hot.c to lock stash for static locked methods. p4raw-id: //depot/perl@248 --- ext/Thread/Thread.pm | 4 ++ ext/Thread/Thread.xs | 99 ++++++++++++++++++++++++++++++------------- ext/Thread/Thread/Specific.pm | 14 ++++++ ext/Thread/join.t | 2 +- ext/Thread/specific.t | 17 ++++++++ 5 files changed, 106 insertions(+), 30 deletions(-) create mode 100644 ext/Thread/Thread/Specific.pm create mode 100644 ext/Thread/specific.t (limited to 'ext') diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm index 2ace5dde2d..1936142e52 100644 --- a/ext/Thread/Thread.pm +++ b/ext/Thread/Thread.pm @@ -15,6 +15,10 @@ sub async (&) { return new Thread $_[0]; } +sub eval { + return eval { shift->join; }; +} + bootstrap Thread; 1; diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 841b5698a1..ba256c9402 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -19,7 +19,7 @@ static int sig_pipe[2]; typedef struct thread *Thread; #define THREAD_RET_TYPE void * #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x) -#endif; +#endif static void remove_thread(struct thread *t) @@ -47,7 +47,7 @@ threadstart(void *arg) dSP; I32 oldscope = scopestack_ix; I32 retval; - AV *returnav; + AV *av; int i; DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", @@ -86,7 +86,8 @@ threadstart(void *arg) I32 oldmark = TOPMARK; I32 oldscope = scopestack_ix; I32 retval; - AV *returnav; + SV *sv; + AV *av = newAV(); int i, ret; dJMPENV; DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", @@ -114,6 +115,7 @@ threadstart(void *arg) DEBUG_L(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); +#ifdef OLD_WAY JMPENV_PUSH(ret); switch (ret) { case 3: @@ -127,7 +129,10 @@ threadstart(void *arg) while (scopestack_ix > oldscope) LEAVE; JMPENV_POP; - av_store(returnav, 0, newSViv(statusvalue)); + MUTEX_LOCK(&thr->mutex); + thr->flags |= THRf_DID_DIE; + MUTEX_UNLOCK(&thr->mutex); + av = newSVpvf("Thread called exit with value %d", statusvalue); goto finishoff; } @@ -143,18 +148,34 @@ threadstart(void *arg) op = pp_entersub(ARGS); if (op) runops(); +#else + sv = POPs; + PUTBACK; + perl_call_sv(sv, G_ARRAY|G_EVAL); +#endif SPAGAIN; retval = sp - (stack_base + oldmark); sp = stack_base + oldmark + 1; - DEBUG_L(for (i = 1; i <= retval; i++) - PerlIO_printf(PerlIO_stderr(), - "%p returnav[%d] = %s\n", - thr, i, SvPEEK(sp[i - 1]));) - returnav = newAV(); - av_store(returnav, 0, newSVpv("", 0)); - for (i = 1; i <= retval; i++, sp++) - sv_setsv(*av_fetch(returnav, i, TRUE), SvREFCNT_inc(*sp)); - + if (SvCUR(thr->errsv)) { + MUTEX_LOCK(&thr->mutex); + thr->flags |= THRf_DID_DIE; + MUTEX_UNLOCK(&thr->mutex); + av_store(av, 0, &sv_no); + av_store(av, 1, newSVsv(thr->errsv)); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", + SvPV(thr->errsv, na)); + } else { + DEBUG_L(STMT_START { + for (i = 1; i <= retval; i++) { + PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", + thr, i, SvPEEK(sp[i - 1]));) + } + } STMT_END); + av_store(av, 0, &sv_yes); + for (i = 1; i <= retval; i++, sp++) + sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*sp)); + } + finishoff: #if 0 /* removed for debug */ @@ -194,7 +215,7 @@ threadstart(void *arg) case THRf_R_DETACHED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); - SvREFCNT_dec(returnav); + SvREFCNT_dec(av); DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: DETACHED thread finished\n", thr)); remove_thread(thr); /* This might trigger main thread to finish */ @@ -204,7 +225,7 @@ threadstart(void *arg) croak("panic: illegal state %u at end of threadstart", ThrSTATE(thr)); /* NOTREACHED */ } - return THREAD_RET_CAST(returnav); /* Available for anyone to join with */ + return THREAD_RET_CAST(av); /* Available for anyone to join with */ /* us unless we're detached, in which */ /* case noone sees the value anyway. */ #endif @@ -214,7 +235,7 @@ threadstart(void *arg) } static SV * -newthread (SV *startsv, AV *initargs, char *Class) +newthread (SV *startsv, AV *initargs, char *classname) { #ifdef USE_THREADS dSP; @@ -274,7 +295,7 @@ newthread (SV *startsv, AV *initargs, char *Class) sv = newSViv(thr->tid); sv_magic(sv, thr->oursv, '~', 0, 0); SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; - return sv_bless(newRV_noinc(sv), gv_stashpv(Class, TRUE)); + return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); #else croak("No threads in this perl"); return &sv_undef; @@ -294,12 +315,12 @@ MODULE = Thread PACKAGE = Thread PROTOTYPES: DISABLE void -new(Class, startsv, ...) - char * Class +new(classname, startsv, ...) + char * classname SV * startsv AV * av = av_make(items - 2, &ST(2)); PPCODE: - XPUSHs(sv_2mortal(newthread(startsv, av, Class))); + XPUSHs(sv_2mortal(newthread(startsv, av, classname))); void join(t) @@ -329,9 +350,17 @@ join(t) } JOIN(t, &av); - /* Could easily speed up the following if necessary */ - for (i = 0; i <= AvFILL(av); i++) - XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); + if (SvTRUE(*av_fetch(av, 0, FALSE))) { + /* Could easily speed up the following if necessary */ + for (i = 1; i <= AvFILL(av); i++) + XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); + } else { + char *mess = SvPV(*av_fetch(av, 1, FALSE), na); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: join propagating die message: %s\n", + thr, mess)); + croak(mess); + } #endif void @@ -379,8 +408,8 @@ flags(t) #endif void -self(Class) - char * Class +self(classname) + char * classname PREINIT: SV *sv; PPCODE: @@ -388,7 +417,8 @@ self(Class) sv = newSViv(thr->tid); sv_magic(sv, thr->oursv, '~', 0, 0); SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; - PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), gv_stashpv(Class, TRUE)))); + PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), + gv_stashpv(classname, TRUE)))); #endif U32 @@ -486,8 +516,8 @@ CODE: #endif void -list(Class) - char * Class +list(classname) + char * classname PREINIT: Thread t; AV * av; @@ -510,7 +540,7 @@ list(Class) SV *sv = newSViv(0); /* fill in tid later */ sv_magic(sv, 0, '~', 0, 0); /* fill in other magic later */ av_push(av, sv_bless(newRV_noinc(sv), - gv_stashpv(Class, TRUE))); + gv_stashpv(classname, TRUE))); } } @@ -580,3 +610,14 @@ await_signal() OUTPUT: RETVAL +MODULE = Thread PACKAGE = Thread::Specific + +void +data(classname = "Thread::Specific") + char * classname + PPCODE: + if (AvFILL(thr->specific) == -1) { + GV *gv = gv_fetchpv("Thread::Specific::FIELDS", TRUE, SVt_PVHV); + av_store(thr->specific, 0, newRV((SV*)GvHV(gv))); + } + XPUSHs(sv_bless(newRV((SV*)thr->specific),gv_stashpv(classname,TRUE))); diff --git a/ext/Thread/Thread/Specific.pm b/ext/Thread/Thread/Specific.pm new file mode 100644 index 0000000000..ec56539e40 --- /dev/null +++ b/ext/Thread/Thread/Specific.pm @@ -0,0 +1,14 @@ +package Thread::Specific; + +sub import { + use attrs qw(locked method); + require fields; + fields->import(@_); +} + +sub key_create { + use attrs qw(locked method); + return ++$FIELDS{__MAX__}; +} + +1; diff --git a/ext/Thread/join.t b/ext/Thread/join.t index 640256a9b3..cba2c1cf56 100644 --- a/ext/Thread/join.t +++ b/ext/Thread/join.t @@ -8,4 +8,4 @@ print "Starting thread\n"; $t = new Thread \&foo, qw(foo bar baz); print "Joining with $t\n"; @results = $t->join(); -print "Joining returned @results\n"; +print "Joining returned ", scalar(@results), " values: @results\n"; diff --git a/ext/Thread/specific.t b/ext/Thread/specific.t new file mode 100644 index 0000000000..da130b1d64 --- /dev/null +++ b/ext/Thread/specific.t @@ -0,0 +1,17 @@ +use Thread; + +use Thread::Specific qw(foo); + +sub count { + my $tid = Thread->self->tid; + my Thread::Specific $tsd = Thread::Specific::data; + for (my $i = 0; $i < 5; $i++) { + $tsd->{foo} = $i; + print "thread $tid count: $tsd->{foo}\n"; + select(undef, undef, undef, rand(2)); + } +}; + +for(my $t = 0; $t < 5; $t++) { + new Thread \&count; +} -- cgit v1.2.1