From: Gurusamy Sarathy Date: Sun, 29 Nov 1998 12:40:28 +0000 (+0000) Subject: various fixes for race conditions under threads: mutex locks based X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b099ddc068b2498767e6f04ac167d9633b895ec4;p=p5sagit%2Fp5-mst-13.2.git various fixes for race conditions under threads: mutex locks based on PL_threadnum were seriously flawed, since it means more than one thread could enter the critical region; PL_na was global instead of thread-local; child thread could finish and free thr structures before Thread->new() got around to creating the Thread object; cv_clone() needed locking, as it mucks with PL_comppad and other global data; new_struct_thread() needed to lock template-thread's mutex while copying its data p4raw-id: //depot/perl@2385 --- diff --git a/embedvar.h b/embedvar.h index 4d28711..bc1d495 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 09751c5..e8dc4a2 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; diff --git a/gv.c b/gv.c index 85ac8f9..1c4c129 100644 --- a/gv.c +++ b/gv.c @@ -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; diff --git a/op.c b/op.c index d98cbd9..85ed393 100644 --- a/op.c +++ b/op.c @@ -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) { diff --git a/perl.c b/perl.c index 9ddf917..991f514 100644 --- a/perl.c +++ b/perl.c @@ -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 17924a9..3860345 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) diff --git a/pp_hot.c b/pp_hot.c index 9b1791d..733b6b0 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -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)); diff --git a/thrdvar.h b/thrdvar.h index 39405e1..69f17fb 100644 --- a/thrdvar.h +++ b/thrdvar.h @@ -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) diff --git a/thread.h b/thread.h index 1312b30..1455683 100644 --- a/thread.h +++ b/thread.h @@ -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 -- 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 diff --git a/util.c b/util.c index 10f1cc7..3be6a91 100644 --- a/util.c +++ b/util.c @@ -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 1eb0e87..b40c5aa 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