diff options
| -rw-r--r-- | embedvar.h | 5 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 19 | ||||
| -rw-r--r-- | gv.c | 1 | ||||
| -rw-r--r-- | op.c | 7 | ||||
| -rw-r--r-- | perl.c | 1 | ||||
| -rw-r--r-- | perlvars.h | 2 | ||||
| -rw-r--r-- | pp_hot.c | 3 | ||||
| -rw-r--r-- | thrdvar.h | 2 | ||||
| -rw-r--r-- | thread.h | 15 | ||||
| -rw-r--r-- | util.c | 39 | ||||
| -rw-r--r-- | win32/win32thread.c | 2 |
11 files changed, 57 insertions, 39 deletions
diff --git a/embedvar.h b/embedvar.h index 4d28711ee5..bc1d495cda 100644 --- a/embedvar.h +++ b/embedvar.h @@ -47,6 +47,7 @@ #define PL_markstack_ptr (PL_curinterp->Tmarkstack_ptr) #define PL_maxscream (PL_curinterp->Tmaxscream) #define PL_modcount (PL_curinterp->Tmodcount) +#define PL_na (PL_curinterp->Tna) #define PL_nrs (PL_curinterp->Tnrs) #define PL_ofs (PL_curinterp->Tofs) #define PL_ofslen (PL_curinterp->Tofslen) @@ -438,6 +439,7 @@ #define PL_Tmarkstack_ptr PL_markstack_ptr #define PL_Tmaxscream PL_maxscream #define PL_Tmodcount PL_modcount +#define PL_Tna PL_na #define PL_Tnrs PL_nrs #define PL_Tofs PL_ofs #define PL_Tofslen PL_ofslen @@ -572,6 +574,7 @@ #define PL_markstack_ptr (thr->Tmarkstack_ptr) #define PL_maxscream (thr->Tmaxscream) #define PL_modcount (thr->Tmodcount) +#define PL_na (thr->Tna) #define PL_nrs (thr->Tnrs) #define PL_ofs (thr->Tofs) #define PL_ofslen (thr->Tofslen) @@ -727,7 +730,6 @@ #define PL_multi_end (PL_Vars.Gmulti_end) #define PL_multi_open (PL_Vars.Gmulti_open) #define PL_multi_start (PL_Vars.Gmulti_start) -#define PL_na (PL_Vars.Gna) #define PL_nexttoke (PL_Vars.Gnexttoke) #define PL_nexttype (PL_Vars.Gnexttype) #define PL_nextval (PL_Vars.Gnextval) @@ -860,7 +862,6 @@ #define PL_Gmulti_end PL_multi_end #define PL_Gmulti_open PL_multi_open #define PL_Gmulti_start PL_multi_start -#define PL_Gna PL_na #define PL_Gnexttoke PL_nexttoke #define PL_Gnexttype PL_nexttype #define PL_Gnextval PL_nextval diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 09751c5f1a..e8dc4a2eca 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -249,11 +249,13 @@ newthread (SV *startsv, AV *initargs, char *classname) XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE))); XPUSHs(SvREFCNT_inc(startsv)); PUTBACK; + + /* On your marks... */ + MUTEX_LOCK(&thr->mutex); + #ifdef THREAD_CREATE err = THREAD_CREATE(thr, threadstart); #else - /* On your marks... */ - MUTEX_LOCK(&thr->mutex); /* Get set... */ sigfillset(&fullmask); if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1) @@ -272,10 +274,10 @@ newthread (SV *startsv, AV *initargs, char *classname) } if (err == 0) err = PTHREAD_CREATE(&thr->self, attr, threadstart, (void*) thr); - /* Go */ - MUTEX_UNLOCK(&thr->mutex); #endif + if (err) { + MUTEX_UNLOCK(&thr->mutex); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: create of %p failed %d\n", savethread, thr, err)); @@ -288,16 +290,23 @@ newthread (SV *startsv, AV *initargs, char *classname) SvREFCNT_dec(startsv); return NULL; } + #ifdef THREAD_POST_CREATE THREAD_POST_CREATE(thr); #else if (sigprocmask(SIG_SETMASK, &oldmask, 0)) croak("panic: sigprocmask"); #endif + 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(classname, TRUE)); + sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE)); + + /* Go */ + MUTEX_UNLOCK(&thr->mutex); + + return sv; #else croak("No threads in this perl"); return &PL_sv_undef; @@ -112,6 +112,7 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) if (doproto) { /* Replicate part of newSUB here. */ SvIOK_off(gv); ENTER; + /* XXX unsafe for threads if eval_owner isn't held */ start_subparse(0,0); /* Create CV in compcv. */ GvCV(gv) = PL_compcv; LEAVE; @@ -3690,7 +3690,11 @@ cv_clone2(CV *proto, CV *outside) CV * cv_clone(CV *proto) { - return cv_clone2(proto, CvOUTSIDE(proto)); + CV *cv; + MUTEX_LOCK(&PL_cred_mutex); /* XXX create separate mutex */ + cv = cv_clone2(proto, CvOUTSIDE(proto)); + MUTEX_UNLOCK(&PL_cred_mutex); /* XXX create separate mutex */ + return cv; } void @@ -4002,6 +4006,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) return cv; } +/* XXX unsafe for threads if eval_owner isn't held */ void newCONSTSUB(HV *stash, char *name, SV *sv) { @@ -1145,6 +1145,7 @@ CV* perl_get_cv(char *name, I32 create) { GV* gv = gv_fetchpv(name, create, SVt_PVCV); + /* XXX unsafe for threads if eval_owner isn't held */ if (create && !GvCVu(gv)) return newSUB(start_subparse(FALSE, 0), newSVOP(OP_CONST, 0, newSVpv(name,0)), diff --git a/perlvars.h b/perlvars.h index 17924a9154..3860345409 100644 --- a/perlvars.h +++ b/perlvars.h @@ -73,8 +73,6 @@ PERLVAR(Gnice_chunk_size, U32) /* how nice the chunk of memory is */ PERLVARI(Grunops, runops_proc_t, FUNC_NAME_TO_PTR(RUNOPS_DEFAULT)) PERLVAR(Gtokenbuf[256], char) -PERLVAR(Gna, STRLEN) /* for use in SvPV when length is - Not Applicable */ PERLVAR(Gsv_undef, SV) PERLVAR(Gsv_no, SV) @@ -2170,8 +2170,7 @@ PP(pp_entersub) * (3) instead of (2) so we'd have to clone. Would the fact * that we released the mutex more quickly make up for this? */ - if (PL_threadnum && - (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE))) + if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE))) { /* We already have a clone to use */ MUTEX_UNLOCK(CvMUTEXP(cv)); @@ -52,6 +52,8 @@ PERLVAR(Tretstack_max, I32) PERLVAR(TSv, SV *) /* used to hold temporary values */ PERLVAR(TXpv, XPV *) /* used to hold temporary values */ +PERLVAR(Tna, STRLEN) /* for use in SvPV when length is + Not Applicable */ /* stat stuff */ PERLVAR(Tstatbuf, Stat_t) @@ -216,6 +216,8 @@ struct perl_thread *getTHR _((void)); * from thrsv which is cached in the per-interpreter structure. * Systems with very fast pthread_get_specific (which should be all systems * but unfortunately isn't) may wish to simplify to "...*thr = THR". + * + * The use of PL_threadnum should be safe here. */ #ifndef dTHR # define dTHR \ @@ -238,30 +240,27 @@ struct perl_thread *getTHR _((void)); * try only locking them if there may be more than one thread in existence. * Systems with very fast mutexes (and/or slow conditionals) may wish to * remove the "if (threadnum) ..." test. + * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions! */ #define LOCK_SV_MUTEX \ STMT_START { \ - if (PL_threadnum) \ - MUTEX_LOCK(&PL_sv_mutex); \ + MUTEX_LOCK(&PL_sv_mutex); \ } STMT_END #define UNLOCK_SV_MUTEX \ STMT_START { \ - if (PL_threadnum) \ - MUTEX_UNLOCK(&PL_sv_mutex); \ + MUTEX_UNLOCK(&PL_sv_mutex); \ } STMT_END /* Likewise for strtab_mutex */ #define LOCK_STRTAB_MUTEX \ STMT_START { \ - if (PL_threadnum) \ - MUTEX_LOCK(&PL_strtab_mutex); \ + MUTEX_LOCK(&PL_strtab_mutex); \ } STMT_END #define UNLOCK_STRTAB_MUTEX \ STMT_START { \ - if (PL_threadnum) \ - MUTEX_UNLOCK(&PL_strtab_mutex); \ + MUTEX_UNLOCK(&PL_strtab_mutex); \ } STMT_END #ifndef THREAD_RET_TYPE @@ -2837,11 +2837,6 @@ new_struct_thread(struct perl_thread *t) thr->flags = THRf_R_JOINABLE; MUTEX_INIT(&thr->mutex); - PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */ - PL_defstash = t->Tdefstash; /* XXX maybe these should */ - PL_curstash = t->Tcurstash; /* always be set to main? */ - - /* top_env needs to be non-zero. It points to an area in which longjmp() stuff is stored, as C callstack info there at least is thread specific this has to @@ -2858,6 +2853,25 @@ new_struct_thread(struct perl_thread *t) PL_in_eval = FALSE; PL_restartop = 0; + PL_statname = NEWSV(66,0); + PL_maxscream = -1; + PL_regcompp = FUNC_NAME_TO_PTR(pregcomp); + PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags); + PL_regindent = 0; + PL_reginterp_cnt = 0; + PL_lastscream = Nullsv; + PL_screamfirst = 0; + PL_screamnext = 0; + PL_reg_start_tmp = 0; + PL_reg_start_tmpl = 0; + + /* parent thread's data needs to be locked while we make copy */ + MUTEX_LOCK(&t->mutex); + + PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */ + PL_defstash = t->Tdefstash; /* XXX maybe these should */ + PL_curstash = t->Tcurstash; /* always be set to main? */ + PL_tainted = t->Ttainted; PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */ PL_nrs = newSVsv(t->Tnrs); @@ -2871,18 +2885,6 @@ new_struct_thread(struct perl_thread *t) PL_bodytarget = newSVsv(t->Tbodytarget); PL_toptarget = newSVsv(t->Ttoptarget); - PL_statname = NEWSV(66,0); - PL_maxscream = -1; - PL_regcompp = FUNC_NAME_TO_PTR(pregcomp); - PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags); - PL_regindent = 0; - PL_reginterp_cnt = 0; - PL_lastscream = Nullsv; - PL_screamfirst = 0; - PL_screamnext = 0; - PL_reg_start_tmp = 0; - PL_reg_start_tmpl = 0; - /* Initialise all per-thread SVs that the template thread used */ svp = AvARRAY(t->threadsv); for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) { @@ -2905,6 +2907,9 @@ new_struct_thread(struct perl_thread *t) thr->next->prev = thr; MUTEX_UNLOCK(&PL_threads_mutex); + /* done copying parent's state */ + MUTEX_UNLOCK(&t->mutex); + #ifdef HAVE_THREAD_INTERN init_thread_intern(thr); #endif /* HAVE_THREAD_INTERN */ diff --git a/win32/win32thread.c b/win32/win32thread.c index 1eb0e872c6..b40c5aa251 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -92,7 +92,6 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) DWORD junk; unsigned long th; - MUTEX_LOCK(&thr->mutex); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: create OS thread\n", thr)); #ifdef USE_RTL_THREAD_API @@ -126,7 +125,6 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) #endif /* !USE_RTL_THREAD_API */ DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk)); - MUTEX_UNLOCK(&thr->mutex); return thr->self ? 0 : -1; } #endif |