From: Nicholas Clark Date: Tue, 11 Apr 2006 19:26:48 +0000 (+0000) Subject: First stab at using the pad to store the serialised hints data. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cbb1fbeae87953fd0cb732e37262675ddbb9ffdd;p=p5sagit%2Fp5-mst-13.2.git First stab at using the pad to store the serialised hints data. This approach is almost certainly not only wrong, but also doomed. But it's needed to build a correct solution. p4raw-id: //depot/perl@27768 --- diff --git a/hv.c b/hv.c index 29c9e43..af8fe67 100644 --- a/hv.c +++ b/hv.c @@ -2577,10 +2577,20 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain) } while (chain) { - const U32 hash = HEK_HASH(chain->refcounted_he_hek); +#ifdef USE_ITHREADS + SV *const sv = *(av_fetch(chain->refcounted_he_pad, + chain->refcounted_he_hek, FALSE)); + U32 hash = SvSHARED_HASH(sv); +#else + U32 hash = HEK_HASH(chain->refcounted_he_hek); +#endif HE **oentry = &((HvARRAY(hv))[hash & max]); HE *entry = *oentry; +#ifdef USE_ITHREADS + assert(SvIsCOW_shared_hash(sv)); +#endif + for (; entry; entry = HeNEXT(entry)) { if (HeHASH(entry) == hash) { goto next_please; @@ -2589,9 +2599,16 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain) assert (!entry); entry = new_HE(); +#ifdef USE_ITHREADS + HeKEY_hek(entry) + = share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv))); + HeVAL(entry) = *(av_fetch(chain->refcounted_he_pad, + chain->refcounted_he_val, FALSE)); +#else HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek); - HeVAL(entry) = chain->refcounted_he_val; +#endif + if (HeVAL(entry) == &PL_sv_placeholder) placeholders++; SvREFCNT_inc_void_NN(HeVAL(entry)); @@ -2648,9 +2665,21 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, Newx(he, 1, struct refcounted_he); he->refcounted_he_next = parent; +#ifdef USE_ITHREADS + he->refcounted_he_hek = pad_alloc(OP_CUSTOM, SVs_PADTMP); + SvREFCNT_dec(PAD_SVl(he->refcounted_he_hek)); + PAD_SETSV(he->refcounted_he_hek, + newSVpvn_share(p, SvUTF8(key) ? -(I32)len : len, hash)); + he->refcounted_he_val = pad_alloc(OP_CUSTOM, SVs_PADTMP); + SvREFCNT_dec(PAD_SVl(he->refcounted_he_val)); + PAD_SETSV(he->refcounted_he_val, value); + he->refcounted_he_pad = PL_comppad; + /* FIXME. This is wrong, but without it t/op/caller.t fails. */ + SvREFCNT_inc_simple_void_NN(he->refcounted_he_pad); +#else he->refcounted_he_val = value; - he->refcounted_he_hek - = share_hek(p, SvUTF8(key) ? -(I32)len : len, hash); + he->refcounted_he_hek = share_hek(p, SvUTF8(key) ? -(I32)len : len, hash); +#endif he->refcounted_he_refcnt = 1; return he; @@ -2670,12 +2699,23 @@ void Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) { while (he) { struct refcounted_he *copy; + U32 new_count; - if (--he->refcounted_he_refcnt) + HINTS_REFCNT_LOCK; + new_count = --he->refcounted_he_refcnt; + HINTS_REFCNT_UNLOCK; + + if (new_count) { return; + } +#ifdef USE_ITHREADS + /* FIXME as above */ + SvREFCNT_dec(he->refcounted_he_pad); +#else unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0); SvREFCNT_dec(he->refcounted_he_val); +#endif copy = he; he = he->refcounted_he_next; Safefree(copy); @@ -2691,7 +2731,7 @@ Duplicates the C for a new thread. =cut */ -#if defined(USE_ITHREADS) +#if 0 struct refcounted_he * Perl_refcounted_he_dup(pTHX_ const struct refcounted_he *const he, CLONE_PARAMS* param) diff --git a/hv.h b/hv.h index 4ae5e1a..223acdb 100644 --- a/hv.h +++ b/hv.h @@ -388,8 +388,14 @@ C. struct refcounted_he { struct refcounted_he *refcounted_he_next; /* next entry in chain */ +#ifdef USE_ITHREADS + PAD *refcounted_he_pad; + PADOFFSET refcounted_he_hek; + PADOFFSET refcounted_he_val; +#else HEK *refcounted_he_hek; /* hint key */ SV *refcounted_he_val; /* hint value */ +#endif U32 refcounted_he_refcnt; /* reference count */ }; diff --git a/op.c b/op.c index 851d35e..64dc9f2 100644 --- a/op.c +++ b/op.c @@ -3956,7 +3956,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) cop->cop_io = newSVsv(PL_curcop->cop_io) ; cop->cop_hints = PL_curcop->cop_hints; if (cop->cop_hints) { + HINTS_REFCNT_LOCK; cop->cop_hints->refcounted_he_refcnt++; + HINTS_REFCNT_UNLOCK; } if (PL_copline == NOLINE) diff --git a/pp_ctl.c b/pp_ctl.c index cb35b59..0cb3787 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3476,27 +3476,13 @@ PP(pp_entereval) SAVEFREESV(PL_compiling.cop_io); } if (PL_compiling.cop_hints) { - PL_compiling.cop_hints->refcounted_he_refcnt--; + Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints); } PL_compiling.cop_hints = PL_curcop->cop_hints; if (PL_compiling.cop_hints) { -#ifdef USE_ITHREADS - /* PL_curcop could be pointing to an optree owned by another /.*parent/ - thread. We can't manipulate the reference count of the refcounted he - there (race condition) so we have to do something less than - pleasant to keep it read only. The simplest solution seems to be to - copy their chain. We might want to cache this. - Alternatively we could add a flag to the refcounted he *we* point to - here saying "I don't own a reference count on the thing I point to", - and arrange for Perl_refcounted_he_free() to spot that. If so, we'd - still need to copy the topmost refcounted he so that we could change - its flag. So still not trivial. (Flag bits could be hung from the - shared HEK) */ - PL_compiling.cop_hints - = Perl_refcounted_he_copy(aTHX_ PL_compiling.cop_hints); -#else + HINTS_REFCNT_LOCK; PL_compiling.cop_hints->refcounted_he_refcnt++; -#endif + HINTS_REFCNT_UNLOCK; } /* special case: an eval '' executed within the DB package gets lexically * placed in the first non-DB CV rather than the current CV - this diff --git a/scope.h b/scope.h index 772eb41..e5160e1 100644 --- a/scope.h +++ b/scope.h @@ -158,7 +158,9 @@ Closing bracket on a callback. See C and L. GvHV(PL_hintgv) = Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)); \ } \ if (PL_compiling.cop_hints) { \ + HINTS_REFCNT_LOCK; \ PL_compiling.cop_hints->refcounted_he_refcnt++; \ + HINTS_REFCNT_UNLOCK; \ } \ SSPUSHPTR(PL_compiling.cop_hints); \ SSPUSHINT(PL_hints); \ diff --git a/sv.c b/sv.c index e84b0e5..cf42029 100644 --- a/sv.c +++ b/sv.c @@ -10578,7 +10578,10 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) i = POPINT(ss,ix); TOPINT(nss,ix) = i; ptr = POPPTR(ss,ix); - TOPPTR(nss,ix) = Perl_refcounted_he_dup(aTHX_ ptr, param); + HINTS_REFCNT_LOCK; + ((COP *)ptr)->cop_hints->refcounted_he_refcnt++; + HINTS_REFCNT_UNLOCK; + TOPPTR(nss,ix) = ptr; if (i & HINT_LOCALIZE_HH) { hv = (HV*)POPPTR(ss,ix); TOPPTR(nss,ix) = hv_dup_inc(hv, param); @@ -10939,8 +10942,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param); if (!specialCopIO(PL_compiling.cop_io)) PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param); - PL_compiling.cop_hints - = Perl_refcounted_he_dup(aTHX_ PL_compiling.cop_hints, param); + if (PL_compiling.cop_hints) { + HINTS_REFCNT_LOCK; + PL_compiling.cop_hints->refcounted_he_refcnt++; + HINTS_REFCNT_UNLOCK; + } PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl); /* pseudo environmental stuff */