From: Dan Sugalski Date: Mon, 8 May 2000 18:08:13 +0000 (-0400) Subject: Threadsafe patches X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b37a7757477319a5fcdd5131db15046064f631c4;p=p5sagit%2Fp5-mst-13.2.git Threadsafe patches To: perl5-porters@perl.org Message-Id: <4.3.1.0.20000508180729.02182de0@24.8.96.48> p4raw-id: //depot/cfgperl@6207 --- diff --git a/embed.pl b/embed.pl index f2628e9..f807d96 100755 --- a/embed.pl +++ b/embed.pl @@ -2497,6 +2497,8 @@ s |void |xstat |int # endif #endif +Arp |SV* |lock |SV *sv + #if defined(PERL_OBJECT) }; #endif diff --git a/global.sym b/global.sym index ec6180b..1d7eb97 100644 --- a/global.sym +++ b/global.sym @@ -542,3 +542,4 @@ Perl_ptr_table_fetch Perl_ptr_table_store Perl_ptr_table_split Perl_sys_intern_init +Perl_lock diff --git a/gv.c b/gv.c index 1868114..39dbd1b 100644 --- a/gv.c +++ b/gv.c @@ -435,9 +435,13 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) */ varstash = GvSTASH(CvGV(cv)); vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE); + ENTER; + Perl_lock(aTHX_ (SV *)varstash); if (!isGV(vargv)) gv_init(vargv, varstash, autoload, autolen, FALSE); + LEAVE; varsv = GvSV(vargv); + Perl_lock(aTHX_ varsv); sv_setpv(varsv, HvNAME(stash)); sv_catpvn(varsv, "::", 2); sv_catpvn(varsv, name, len); diff --git a/intrpvar.h b/intrpvar.h index d7e4025..0540d2e 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -443,6 +443,10 @@ PERLVAR(IProc, struct IPerlProc*) #if defined(USE_ITHREADS) PERLVAR(Iptr_table, PTR_TBL_t*) #endif + +#if defined(USE_THREADS) +PERLVAR(Isv_lock_mutex, perl_mutex) /* Mutex for SvLOCK macro */ +#endif PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */ PERLVAR(Inullstash, HV *) /* illegal symbols end up here */ diff --git a/perl.c b/perl.c index b40e617..b36eb89 100644 --- a/perl.c +++ b/perl.c @@ -180,6 +180,7 @@ perl_construct(pTHXx) # endif /* EMULATE_ATOMIC_REFCOUNTS */ MUTEX_INIT(&PL_cred_mutex); + MUTEX_INIT(&PL_sv_lock_mutex); thr = init_main_thread(); #endif /* USE_THREADS */ diff --git a/pp.c b/pp.c index fc3a4a7..428b2e4 100644 --- a/pp.c +++ b/pp.c @@ -5257,24 +5257,7 @@ PP(pp_lock) dTOPss; SV *retsv = sv; #ifdef USE_THREADS - MAGIC *mg; - - if (SvROK(sv)) - sv = SvRV(sv); - - mg = condpair_magic(sv); - MUTEX_LOCK(MgMUTEXP(mg)); - if (MgOWNER(mg) == thr) - MUTEX_UNLOCK(MgMUTEXP(mg)); - else { - while (MgOWNER(mg)) - COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); - MgOWNER(mg) = thr; - DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n", - PTR2UV(thr), PTR2UV(sv));) - MUTEX_UNLOCK(MgMUTEXP(mg)); - SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); - } + Perl_lock(aTHX_ sv); #endif /* USE_THREADS */ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV || SvTYPE(retsv) == SVt_PVCV) { diff --git a/pp_ctl.c b/pp_ctl.c index 801f3f1..995c202 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -891,6 +891,10 @@ PP(pp_sort) PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV); PL_sortstash = stash; } +#ifdef USE_THREADS + Perl_lock(aTHX_ (SV *)PL_firstgv); + Perl_lock(aTHX_ (SV *)PL_secondgv); +#endif SAVESPTR(GvSV(PL_firstgv)); SAVESPTR(GvSV(PL_secondgv)); } diff --git a/proto.h b/proto.h index 28c9581..afe67b1 100644 --- a/proto.h +++ b/proto.h @@ -1259,6 +1259,8 @@ STATIC void S_xstat(pTHX_ int); # endif #endif +PERL_CALLCONV SV* Perl_lock(pTHX_ SV *sv) __attribute__((noreturn)); + #if defined(PERL_OBJECT) }; #endif diff --git a/sv.h b/sv.h index c0ce967..4251fe4 100644 --- a/sv.h +++ b/sv.h @@ -123,21 +123,26 @@ perform the upgrade if necessary. See C. #ifdef USE_THREADS -# ifdef EMULATE_ATOMIC_REFCOUNTS -# define ATOMIC_INC(count) STMT_START { \ - MUTEX_LOCK(&PL_svref_mutex); \ - ++count; \ - MUTEX_UNLOCK(&PL_svref_mutex); \ - } STMT_END -# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \ - MUTEX_LOCK(&PL_svref_mutex); \ - res = (--count == 0); \ - MUTEX_UNLOCK(&PL_svref_mutex); \ - } STMT_END -# else -# define ATOMIC_INC(count) atomic_inc(&count) -# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count)) -# endif /* EMULATE_ATOMIC_REFCOUNTS */ +# if defined(VMS) +# define ATOMIC_INC(count) __ATOMIC_INCREMENT_LONG(&count) +# define ATOMIC_DEC_AND_TEST(res,count) res=(1==__ATOMIC_DECREMENT_LONG(&count)) + # else +# ifdef EMULATE_ATOMIC_REFCOUNTS + # define ATOMIC_INC(count) STMT_START { \ + MUTEX_LOCK(&PL_svref_mutex); \ + ++count; \ + MUTEX_UNLOCK(&PL_svref_mutex); \ + } STMT_END +# define ATOMIC_DEC_AND_TEST(res,count) STMT_START { \ + MUTEX_LOCK(&PL_svref_mutex); \ + res = (--count == 0); \ + MUTEX_UNLOCK(&PL_svref_mutex); \ + } STMT_END +# else +# define ATOMIC_INC(count) atomic_inc(&count) +# define ATOMIC_DEC_AND_TEST(res,count) (res = atomic_dec_and_test(&count)) +# endif /* EMULATE_ATOMIC_REFCOUNTS */ +# endif /* VMS */ #else # define ATOMIC_INC(count) (++count) # define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0)) @@ -153,7 +158,12 @@ perform the upgrade if necessary. See C. }) #else # if defined(CRIPPLED_CC) || defined(USE_THREADS) -# define SvREFCNT_inc(sv) sv_newref((SV*)sv) +# if defined(VMS) && defined(__ALPHA) +# define SvREFCNT_inc(sv) \ + (PL_Sv=(SV*)(sv), (PL_Sv && __ATOMIC_INCREMENT_LONG(&(SvREFCNT(PL_Sv)))), (SV *)PL_Sv) +# else +# define SvREFCNT_inc(sv) sv_newref((SV*)sv) +# endif # else # define SvREFCNT_inc(sv) \ ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv) @@ -997,6 +1007,13 @@ indicated number of bytes (remember to reserve space for an extra trailing NUL character). Calls C to perform the expansion if necessary. Returns a pointer to the character buffer. +=for apidoc Am|void|SvLOCK|SV* sv +Aquires an internal mutex for a SV. Used to make sure multiple threads +don't stomp on the guts of an SV at the same time + +=for apidoc Am|void|SvUNLOCK|SV* sv +Release the internal mutex for an SV. + =cut */ @@ -1032,6 +1049,9 @@ Returns a pointer to the character buffer. SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) #ifdef DEBUGGING + +#define SvLOCK(sv) MUTEX_LOCK(&PL_sv_lock_mutex) +#define SvUNLOCK(sv) MUTEX_UNLOCK(&PL_sv_lock_mutex) #define SvPEEK(sv) sv_peek(sv) #else #define SvPEEK(sv) "" diff --git a/util.c b/util.c index 8962fff..dd8c842 100644 --- a/util.c +++ b/util.c @@ -3492,6 +3492,38 @@ Perl_condpair_magic(pTHX_ SV *sv) return mg; } +SV * +Perl_lock(pTHX_ SV *osv) +{ +#ifdef USE_THREADS + MAGIC *mg; + SV *sv = osv; + + SvLOCK(osv); + if (SvROK(sv)) { + sv = SvRV(sv); + SvUNLOCK(osv); + SvLOCK(sv); + } + + mg = condpair_magic(sv); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) == thr) + MUTEX_UNLOCK(MgMUTEXP(mg)); + else { + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(sv));) + MUTEX_UNLOCK(MgMUTEXP(mg)); + SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); + } +#endif + SvUNLOCK(sv); + return sv; +} + /* * Make a new perl thread structure using t as a prototype. Some of the * fields for the new thread are copied from the prototype thread, t,