X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=03855f367176e63096c84c4284d9f48c804fbe19;hb=7e107e90b7bd52c7fb110ac98da6bb7ab38e8959;hp=526468df815ff28843d5a332057da799fca4ddbc;hpb=8514a05ad77d06390899752b405c952ef7bae9d5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 526468d..03855f3 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -21,10 +21,6 @@ /* Hot code. */ -#ifdef USE_5005THREADS -static void unset_cvowner(pTHX_ void *cvarg); -#endif /* USE_5005THREADS */ - PP(pp_const) { dSP; @@ -197,10 +193,10 @@ PP(pp_padsv) XPUSHs(TARG); if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) - SAVECLEARSV(PL_curpad[PL_op->op_targ]); + SAVECLEARSV(PAD_SVl(PL_op->op_targ)); else if (PL_op->op_private & OPpDEREF) { PUTBACK; - vivify_ref(PL_curpad[PL_op->op_targ], PL_op->op_private & OPpDEREF); + vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF); SPAGAIN; } } @@ -320,6 +316,42 @@ PP(pp_or) } } +PP(pp_dor) +{ + /* Most of this is lifted straight from pp_defined */ + dSP; + register SV* sv; + + sv = TOPs; + if (!sv || !SvANY(sv)) { + --SP; + RETURNOP(cLOGOP->op_other); + } + + switch (SvTYPE(sv)) { + case SVt_PVAV: + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + RETURN; + break; + case SVt_PVHV: + if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + RETURN; + break; + case SVt_PVCV: + if (CvROOT(sv) || CvXSUB(sv)) + RETURN; + break; + default: + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvOK(sv)) + RETURN; + } + + --SP; + RETURNOP(cLOGOP->op_other); +} + PP(pp_add) { dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN); @@ -571,7 +603,7 @@ PP(pp_print) goto had_magic; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); - SETERRNO(EBADF,RMS$_IFI); + SETERRNO(EBADF,RMS_IFI); goto just_say_no; } else if (!(fp = IoOFP(io))) { @@ -581,7 +613,7 @@ PP(pp_print) else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); } - SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); + SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); goto just_say_no; } else { @@ -744,7 +776,7 @@ PP(pp_rv2av) } SP += maxarg; } - else { + else if (GIMME_V == G_SCALAR) { dTARGET; I32 maxarg = AvFILL(av) + 1; SETi(maxarg); @@ -762,7 +794,7 @@ PP(pp_rv2hv) tryAMAGICunDEREF(to_hv); hv = (HV*)SvRV(sv); - if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV) + if (SvTYPE(hv) != SVt_PVHV) DIE(aTHX_ "Not a HASH reference"); if (PL_op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -776,7 +808,7 @@ PP(pp_rv2hv) } } else { - if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) { + if (SvTYPE(sv) == SVt_PVHV) { hv = (HV*)sv; if (PL_op->op_flags & OPf_REF) { SETs((SV*)hv); @@ -858,8 +890,6 @@ PP(pp_rv2hv) } else { dTARGET; - if (SvTYPE(hv) == SVt_PVAV) - hv = avhv_keys((AV*)hv); if (HvFILL(hv)) Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf, (IV)HvFILL(hv), (IV)HvMAX(hv) + 1); @@ -871,57 +901,14 @@ PP(pp_rv2hv) } } -STATIC int -S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem, - SV **lastrelem) -{ - OP *leftop; - I32 i; - - leftop = ((BINOP*)PL_op)->op_last; - assert(leftop); - assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST); - leftop = ((LISTOP*)leftop)->op_first; - assert(leftop); - /* Skip PUSHMARK and each element already assigned to. */ - for (i = lelem - firstlelem; i > 0; i--) { - leftop = leftop->op_sibling; - assert(leftop); - } - if (leftop->op_type != OP_RV2HV) - return 0; - - /* pseudohash */ - if (av_len(ary) > 0) - av_fill(ary, 0); /* clear all but the fields hash */ - if (lastrelem >= relem) { - while (relem < lastrelem) { /* gobble up all the rest */ - SV *tmpstr; - assert(relem[0]); - assert(relem[1]); - /* Avoid a memory leak when avhv_store_ent dies. */ - tmpstr = sv_newmortal(); - sv_setsv(tmpstr,relem[1]); /* value */ - relem[1] = tmpstr; - if (avhv_store_ent(ary,relem[0],tmpstr,0)) - (void)SvREFCNT_inc(tmpstr); - if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - relem += 2; - TAINT_NOT; - } - } - if (relem == lastrelem) - return 1; - return 2; -} - STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) { if (*relem) { SV *tmpstr; - if (ckWARN(WARN_MISC)) { + HE *didstore; + + if (ckWARN(WARN_MISC)) { if (relem == firstrelem && SvROK(*relem) && (SvTYPE(SvRV(*relem)) == SVt_PVAV || @@ -934,26 +921,16 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in hash assignment"); } - if (SvTYPE(hash) == SVt_PVAV) { - /* pseudohash */ - tmpstr = sv_newmortal(); - if (avhv_store_ent((AV*)hash,*relem,tmpstr,0)) - (void)SvREFCNT_inc(tmpstr); - if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - } - else { - HE *didstore; - tmpstr = NEWSV(29,0); - didstore = hv_store_ent(hash,*relem,tmpstr,0); - if (SvMAGICAL(hash)) { - if (SvSMAGICAL(tmpstr)) - mg_set(tmpstr); - if (!didstore) - sv_2mortal(tmpstr); - } - } - TAINT_NOT; + + tmpstr = NEWSV(29,0); + didstore = hv_store_ent(hash,*relem,tmpstr,0); + if (SvMAGICAL(hash)) { + if (SvSMAGICAL(tmpstr)) + mg_set(tmpstr); + if (!didstore) + sv_2mortal(tmpstr); + } + TAINT_NOT; } } @@ -1005,19 +982,6 @@ PP(pp_aassign) case SVt_PVAV: ary = (AV*)sv; magic = SvMAGICAL(ary) != 0; - if (PL_op->op_private & OPpASSIGN_HASH) { - switch (do_maybe_phash(ary, lelem, firstlelem, relem, - lastrelem)) - { - case 0: - goto normal_array; - case 1: - do_oddball((HV*)ary, relem, firstrelem); - } - relem = lastrelem + 1; - break; - } - normal_array: av_clear(ary); av_extend(ary, lastrelem - relem); i = 0; @@ -1454,8 +1418,11 @@ Perl_do_readline(pTHX) call_method("READLINE", gimme); LEAVE; SPAGAIN; - if (gimme == G_SCALAR) - SvSetMagicSV_nosteal(TARG, TOPs); + if (gimme == G_SCALAR) { + SV* result = POPs; + SvSetSV_nosteal(TARG, result); + PUSHTARG; + } RETURN; } fp = Nullfp; @@ -1513,10 +1480,14 @@ Perl_do_readline(pTHX) tmplen = SvLEN(sv); /* remember if already alloced */ if (!tmplen) Sv_Grow(sv, 80); /* try short-buffering it */ - if (type == OP_RCATLINE) + offset = 0; + if (type == OP_RCATLINE && SvOK(sv)) { + if (!SvPOK(sv)) { + STRLEN n_a; + (void)SvPV_force(sv, n_a); + } offset = SvCUR(sv); - else - offset = 0; + } } else { sv = sv_2mortal(NEWSV(57, 80)); @@ -1639,7 +1610,11 @@ PP(pp_helem) U32 lval = PL_op->op_flags & OPf_MOD || LVRET; U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; +#ifdef PERL_COPY_ON_WRITE + U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0; +#else U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; +#endif I32 preeminent = 0; if (SvTYPE(hv) == SVt_PVHV) { @@ -1665,11 +1640,6 @@ PP(pp_helem) he = hv_fetch_ent(hv, keysv, lval && !defer, hash); svp = he ? &HeVAL(he) : 0; } - else if (SvTYPE(hv) == SVt_PVAV) { - if (PL_op->op_private & OPpLVAL_INTRO) - DIE(aTHX_ "Can't localize pseudo-hash element"); - svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, hash); - } else { RETPUSHUNDEF; } @@ -1798,13 +1768,11 @@ PP(pp_iter) STRLEN maxlen; char *max = SvPV((SV*)av, maxlen); if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { -#ifndef USE_5005THREADS /* don't risk potential race */ if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) { /* safe to reuse old SV */ sv_setsv(*itersvp, cur); } else -#endif { /* we need a fresh SV every time so that loop body sees a * completely new SV for closures/references to work as @@ -1824,13 +1792,12 @@ PP(pp_iter) if (cx->blk_loop.iterix > cx->blk_loop.itermax) RETPUSHNO; -#ifndef USE_5005THREADS /* don't risk potential race */ + /* don't risk potential race */ if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) { /* safe to reuse old SV */ sv_setiv(*itersvp, cx->blk_loop.iterix++); } else -#endif { /* we need a fresh SV every time so that loop body sees a * completely new SV for closures/references to work as they @@ -1920,8 +1887,8 @@ PP(pp_subst) EXTEND(SP,1); } - if (SvFAKE(TARG) && SvREADONLY(TARG)) - sv_force_normal(TARG); + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG,0); if (SvREADONLY(TARG) || (SvTYPE(TARG) > SVt_PVLV && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))) @@ -1983,16 +1950,20 @@ PP(pp_subst) /* known replacement string? */ if (dstr) { - c = SvPV(dstr, clen); - doutf8 = DO_UTF8(dstr); /* replacement needing upgrading? */ if (DO_UTF8(TARG) && !doutf8) { - SV *nsv = newSVpvn(c, clen); + SV *nsv = sv_newmortal(); + SvSetSV(nsv, dstr); if (PL_encoding) sv_recode_to_utf8(nsv, PL_encoding); else sv_utf8_upgrade(nsv); c = SvPV(nsv, clen); + doutf8 = TRUE; + } + else { + c = SvPV(dstr, clen); + doutf8 = DO_UTF8(dstr); } } else { @@ -2346,8 +2317,9 @@ PP(pp_leavesublv) PL_curpm = newpm; LEAVE; LEAVESUB(sv); - DIE(aTHX_ "Can't return a %s from lvalue subroutine", - SvREADONLY(TOPs) ? "readonly value" : "temporary"); + DIE(aTHX_ "Can't return %s from lvalue subroutine", + SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef" + : "a readonly value" : "a temporary"); } else { /* Can be a localized value * subject to deletion. */ @@ -2579,140 +2551,6 @@ try_autoload: DIE(aTHX_ "No DBsub routine"); } -#ifdef USE_5005THREADS - /* - * First we need to check if the sub or method requires locking. - * If so, we gain a lock on the CV, the first argument or the - * stash (for static methods), as appropriate. This has to be - * inline because for FAKE_THREADS, COND_WAIT inlines code to - * reschedule by returning a new op. - */ - MUTEX_LOCK(CvMUTEXP(cv)); - if (CvFLAGS(cv) & CVf_LOCKED) { - MAGIC *mg; - if (CvFLAGS(cv) & CVf_METHOD) { - if (SP > PL_stack_base + TOPMARK) - sv = *(PL_stack_base + TOPMARK + 1); - else { - AV *av = (AV*)PL_curpad[0]; - if (hasargs || !av || AvFILLp(av) < 0 - || !(sv = AvARRAY(av)[0])) - { - MUTEX_UNLOCK(CvMUTEXP(cv)); - DIE(aTHX_ "no argument for locked method call"); - } - } - if (SvROK(sv)) - sv = SvRV(sv); - else { - STRLEN len; - char *stashname = SvPV(sv, len); - sv = (SV*)gv_stashpvn(stashname, len, TRUE); - } - } - else { - sv = (SV*)cv; - } - MUTEX_UNLOCK(CvMUTEXP(cv)); - 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, "%p: pp_entersub lock %p\n", - thr, sv)); - MUTEX_UNLOCK(MgMUTEXP(mg)); - SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); - } - MUTEX_LOCK(CvMUTEXP(cv)); - } - /* - * Now we have permission to enter the sub, we must distinguish - * four cases. (0) It's an XSUB (in which case we don't care - * about ownership); (1) it's ours already (and we're recursing); - * (2) it's free (but we may already be using a cached clone); - * (3) another thread owns it. Case (1) is easy: we just use it. - * Case (2) means we look for a clone--if we have one, use it - * otherwise grab ownership of cv. Case (3) means we look for a - * clone (for non-XSUBs) and have to create one if we don't - * already have one. - * Why look for a clone in case (2) when we could just grab - * ownership of cv straight away? Well, we could be recursing, - * i.e. we originally tried to enter cv while another thread - * owned it (hence we used a clone) but it has been freed up - * and we're now recursing into it. It may or may not be "better" - * to use the clone but at least CvDEPTH can be trusted. - */ - if (CvOWNER(cv) == thr || CvXSUB(cv)) - MUTEX_UNLOCK(CvMUTEXP(cv)); - else { - /* Case (2) or (3) */ - SV **svp; - - /* - * XXX Might it be better to release CvMUTEXP(cv) while we - * do the hv_fetch? We might find someone has pinched it - * when we look again, in which case we would be in case - * (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 ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE))) - { - /* We already have a clone to use */ - MUTEX_UNLOCK(CvMUTEXP(cv)); - cv = *(CV**)svp; - DEBUG_S(PerlIO_printf(Perl_debug_log, - "entersub: %p already has clone %p:%s\n", - thr, cv, SvPEEK((SV*)cv))); - CvOWNER(cv) = thr; - SvREFCNT_inc(cv); - if (CvDEPTH(cv) == 0) - SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv); - } - else { - /* (2) => grab ownership of cv. (3) => make clone */ - if (!CvOWNER(cv)) { - CvOWNER(cv) = thr; - SvREFCNT_inc(cv); - MUTEX_UNLOCK(CvMUTEXP(cv)); - DEBUG_S(PerlIO_printf(Perl_debug_log, - "entersub: %p grabbing %p:%s in stash %s\n", - thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ? - HvNAME(CvSTASH(cv)) : "(none)")); - } - else { - /* Make a new clone. */ - CV *clonecv; - SvREFCNT_inc(cv); /* don't let it vanish from under us */ - MUTEX_UNLOCK(CvMUTEXP(cv)); - DEBUG_S((PerlIO_printf(Perl_debug_log, - "entersub: %p cloning %p:%s\n", - thr, cv, SvPEEK((SV*)cv)))); - /* - * We're creating a new clone so there's no race - * between the original MUTEX_UNLOCK and the - * SvREFCNT_inc since no one will be trying to undef - * it out from underneath us. At least, I don't think - * there's a race... - */ - clonecv = cv_clone(cv); - SvREFCNT_dec(cv); /* finished with this */ - hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0); - CvOWNER(clonecv) = thr; - cv = clonecv; - SvREFCNT_inc(cv); - } - DEBUG_S(if (CvDEPTH(cv) != 0) - PerlIO_printf(Perl_debug_log, "depth %ld != 0\n", - CvDEPTH(cv))); - SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv); - } - } -#endif /* USE_5005THREADS */ - if (CvXSUB(cv)) { #ifdef PERL_XSUB_OLDSTYLE if (CvOLDSTYLE(cv)) { @@ -2744,11 +2582,7 @@ try_autoload: * back. This would allow popping @_ in XSUB, e.g.. XXXX */ AV* av; I32 items; -#ifdef USE_5005THREADS - av = (AV*)PL_curpad[0]; -#else av = GvAV(PL_defgv); -#endif /* USE_5005THREADS */ items = AvFILLp(av) + 1; /* @_ is not tieable */ if (items) { @@ -2784,81 +2618,23 @@ try_autoload: dMARK; register I32 items = SP - MARK; AV* padlist = CvPADLIST(cv); - SV** svp = AvARRAY(padlist); push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_SUB, MARK); PUSHSUB(cx); CvDEPTH(cv)++; /* XXX This would be a natural place to set C so * that eval'' ops within this sub know the correct lexical space. - * Owing the speed considerations, we choose to search for the cv - * in doeval() instead. + * Owing the speed considerations, we choose instead to search for + * the cv using find_runcv() when calling doeval(). */ if (CvDEPTH(cv) < 2) (void)SvREFCNT_inc(cv); - else { /* save temporaries on recursion? */ + else { PERL_STACK_OVERFLOW_CHECK(); - if (CvDEPTH(cv) > AvFILLp(padlist)) { - AV *av; - AV *newpad = newAV(); - SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); - I32 ix = AvFILLp((AV*)svp[1]); - I32 names_fill = AvFILLp((AV*)svp[0]); - svp = AvARRAY(svp[0]); - for ( ;ix > 0; ix--) { - if (names_fill >= ix && svp[ix] != &PL_sv_undef) { - char *name = SvPVX(svp[ix]); - if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */ - || *name == '&') /* anonymous code? */ - { - av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); - } - else { /* our own lexical */ - if (*name == '@') - av_store(newpad, ix, sv = (SV*)newAV()); - else if (*name == '%') - av_store(newpad, ix, sv = (SV*)newHV()); - else - av_store(newpad, ix, sv = NEWSV(0,0)); - SvPADMY_on(sv); - } - } - else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { - av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix])); - } - else { - av_store(newpad, ix, sv = NEWSV(0,0)); - SvPADTMP_on(sv); - } - } - av = newAV(); /* will be @_ */ - av_extend(av, 0); - av_store(newpad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; - av_store(padlist, CvDEPTH(cv), (SV*)newpad); - AvFILLp(padlist) = CvDEPTH(cv); - svp = AvARRAY(padlist); - } - } -#ifdef USE_5005THREADS - if (!hasargs) { - AV* av = (AV*)PL_curpad[0]; - - items = AvFILLp(av) + 1; - if (items) { - /* Mark is at the end of the stack. */ - EXTEND(SP, items); - Copy(AvARRAY(av), SP + 1, items, SV*); - SP += items; - PUTBACK ; - } - } -#endif /* USE_5005THREADS */ - SAVEVPTR(PL_curpad); - PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); -#ifndef USE_5005THREADS + pad_push(padlist, CvDEPTH(cv), 1); + } + PAD_SET_CUR(padlist, CvDEPTH(cv)); if (hasargs) -#endif /* USE_5005THREADS */ { AV* av; SV** ary; @@ -2867,7 +2643,7 @@ try_autoload: DEBUG_S(PerlIO_printf(Perl_debug_log, "%p entersub preparing @_\n", thr)); #endif - av = (AV*)PL_curpad[0]; + av = (AV*)PAD_SVl(0); if (AvREAL(av)) { /* @_ is normally not REAL--this should only ever * happen when DB::sub() calls things that modify @_ */ @@ -2875,11 +2651,9 @@ try_autoload: AvREAL_off(av); AvREIFY_on(av); } -#ifndef USE_5005THREADS cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); -#endif /* USE_5005THREADS */ - cx->blk_sub.oldcurpad = PL_curpad; + CX_CURPAD_SAVE(cx->blk_sub); cx->blk_sub.argarray = av; ++MARK; @@ -3046,6 +2820,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) char* name; STRLEN namelen; char* packname = 0; + SV *packsv = Nullsv; STRLEN packlen; name = SvPV(meth, namelen); @@ -3081,6 +2856,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } /* assume it's a package name */ stash = gv_stashpvn(packname, packlen, FALSE); + if (!stash) + packsv = sv; goto fetch; } /* it _is_ a filehandle name -- replace with a reference */ @@ -3113,7 +2890,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } } - gv = gv_fetchmethod(stash, name); + gv = gv_fetchmethod(stash ? stash : (HV*)packsv, name); if (!gv) { /* This code tries to figure out just what went wrong with @@ -3160,22 +2937,3 @@ S_method_common(pTHX_ SV* meth, U32* hashp) } return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv; } - -#ifdef USE_5005THREADS -static void -unset_cvowner(pTHX_ void *cvarg) -{ - register CV* cv = (CV *) cvarg; - - DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n", - thr, cv, SvPEEK((SV*)cv)))); - MUTEX_LOCK(CvMUTEXP(cv)); - DEBUG_S(if (CvDEPTH(cv) != 0) - PerlIO_printf(Perl_debug_log, "depth %ld != 0\n", - CvDEPTH(cv))); - assert(thr == CvOWNER(cv)); - CvOWNER(cv) = 0; - MUTEX_UNLOCK(CvMUTEXP(cv)); - SvREFCNT_dec(cv); -} -#endif /* USE_5005THREADS */