X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=03eeb71ea1f586be13ae810bcbb1dde76b8eac80;hb=99710fe38e53c8e763d4758979c48cc5bc8503cf;hp=57fa32896a66bf6e1fae1d5a86a1af99809f7f95;hpb=4efa5a16764cb3324df705f9698e0a426a289960;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 57fa328..03eeb71 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -43,7 +43,7 @@ PP(pp_const) /* This is a const op added to hold the hints hash for pp_entereval. The hash can be modified by the code being eval'ed, so we return a copy instead. */ - XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv))); + mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)); else /* Normal const. */ XPUSHs(cSVOP_sv); @@ -150,7 +150,7 @@ PP(pp_sassign) The gv becomes a(nother) reference to the constant. */ SV *const value = SvRV(cv); - SvUPGRADE((SV *)gv, SVt_RV); + SvUPGRADE((SV *)gv, SVt_IV); SvPCS_IMPORTED_on(gv); SvRV_set(gv, value); SvREFCNT_inc_simple_void(value); @@ -248,7 +248,7 @@ PP(pp_concat) /* mg_get(right) may happen here ... */ rpv = SvPV_const(right, rlen); rbyte = !DO_UTF8(right); - right = sv_2mortal(newSVpvn(rpv, rlen)); + right = newSVpvn_flags(rpv, rlen, SVs_TEMP); rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */ rcopied = TRUE; } @@ -287,7 +287,7 @@ PP(pp_concat) sv_utf8_upgrade_nomg(TARG); else { if (!rcopied) - right = sv_2mortal(newSVpvn(rpv, rlen)); + right = newSVpvn_flags(rpv, rlen, SVs_TEMP); sv_utf8_upgrade_nomg(right); rpv = SvPV_const(right, rlen); } @@ -731,6 +731,11 @@ PP(pp_print) *MARK = SvTIED_obj((SV*)io, mg); PUTBACK; ENTER; + if( PL_op->op_type == OP_SAY ) { + /* local $\ = "\n" */ + SAVEGENERICSV(PL_ors_sv); + PL_ors_sv = newSVpvs("\n"); + } call_method("PRINT", G_SCALAR); LEAVE; SPAGAIN; @@ -1192,12 +1197,23 @@ PP(pp_qr) dVAR; dSP; register PMOP * const pm = cPMOP; REGEXP * rx = PM_GETRE(pm); - SV * const pkg = CALLREG_PACKAGE(rx); + SV * const pkg = rx ? CALLREG_PACKAGE(rx) : NULL; SV * const rv = sv_newmortal(); - SV * const sv = newSVrv(rv, SvPV_nolen(pkg)); - if (rx->extflags & RXf_TAINTED) + + SvUPGRADE(rv, SVt_IV); + /* This RV is about to own a reference to the regexp. (In addition to the + reference already owned by the PMOP. */ + ReREFCNT_inc(rx); + SvRV_set(rv, (SV*) rx); + SvROK_on(rv); + + if (pkg) { + HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD); + (void)sv_bless(rv, stash); + } + + if (RX_EXTFLAGS(rx) & RXf_TAINTED) SvTAINTED_on(rv); - sv_magic(sv,(SV*)ReREFCNT_inc(rx), PERL_MAGIC_qr,0,0); XPUSHs(rv); RETURN; } @@ -1237,7 +1253,7 @@ PP(pp_match) if (!s) DIE(aTHX_ "panic: pp_match"); strend = s + len; - rxtainted = ((rx->extflags & RXf_TAINTED) || + rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) || (PL_tainted && (pm->op_pmflags & PMf_RETAINT))); TAINT_NOT; @@ -1260,32 +1276,32 @@ PP(pp_match) /* empty pattern special-cased to use last successful pattern if possible */ - if (!rx->prelen && PL_curpm) { + if (!RX_PRELEN(rx) && PL_curpm) { pm = PL_curpm; rx = PM_GETRE(pm); } - if (rx->minlen > (I32)len) + if (RX_MINLEN(rx) > (I32)len) goto failure; truebase = t = s; /* XXXX What part of this is needed with true \G-support? */ if ((global = dynpm->op_pmflags & PMf_GLOBAL)) { - rx->offs[0].start = -1; + RX_OFFS(rx)[0].start = -1; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { - if (!(rx->extflags & RXf_GPOS_SEEN)) - rx->offs[0].end = rx->offs[0].start = mg->mg_len; - else if (rx->extflags & RXf_ANCH_GPOS) { + if (!(RX_EXTFLAGS(rx) & RXf_GPOS_SEEN)) + RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len; + else if (RX_EXTFLAGS(rx) & RXf_ANCH_GPOS) { r_flags |= REXEC_IGNOREPOS; - rx->offs[0].end = rx->offs[0].start = mg->mg_len; - } else if (rx->extflags & RXf_GPOS_FLOAT) + RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len; + } else if (RX_EXTFLAGS(rx) & RXf_GPOS_FLOAT) gpos = mg->mg_len; else - rx->offs[0].end = rx->offs[0].start = mg->mg_len; - minmatch = (mg->mg_flags & MGf_MINMATCH) ? rx->gofs + 1 : 0; + RX_OFFS(rx)[0].end = RX_OFFS(rx)[0].start = mg->mg_len; + minmatch = (mg->mg_flags & MGf_MINMATCH) ? RX_GOFS(rx) + 1 : 0; update_minmatch = 0; } } @@ -1295,39 +1311,40 @@ PP(pp_match) /g matches against large strings. So far a solution to this problem appears to be quite tricky. Test for the unsafe vars are TODO for now. */ - if (( !global && rx->nparens) + if (( !global && RX_NPARENS(rx)) || SvTEMP(TARG) || PL_sawampersand || - (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))) + (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY))) r_flags |= REXEC_COPY_STR; if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; play_it_again: - if (global && rx->offs[0].start != -1) { - t = s = rx->offs[0].end + truebase - rx->gofs; - if ((s + rx->minlen) > strend || s < truebase) + if (global && RX_OFFS(rx)[0].start != -1) { + t = s = RX_OFFS(rx)[0].end + truebase - RX_GOFS(rx); + if ((s + RX_MINLEN(rx)) > strend || s < truebase) goto nope; if (update_minmatch++) minmatch = had_zerolen; } - if (rx->extflags & RXf_USE_INTUIT && - DO_UTF8(TARG) == ((rx->extflags & RXf_UTF8) != 0)) { + if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT && + DO_UTF8(TARG) == (RX_UTF8(rx) != 0)) { /* FIXME - can PL_bostr be made const char *? */ PL_bostr = (char *)truebase; s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL); if (!s) goto nope; - if ( (rx->extflags & RXf_CHECK_ALL) + if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL) && !PL_sawampersand - && !(rx->extflags & RXf_PMf_KEEPCOPY) - && ((rx->extflags & RXf_NOSCAN) - || !((rx->extflags & RXf_INTUIT_TAIL) + && !(RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) + && ((RX_EXTFLAGS(rx) & RXf_NOSCAN) + || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL) && (r_flags & REXEC_SCREAM))) && !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */ goto yup; } - if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, INT2PTR(void*, gpos), r_flags)) + if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, + minmatch, TARG, NUM2PTR(void*, gpos), r_flags)) { PL_curpm = pm; if (dynpm->op_pmflags & PMf_ONCE) { @@ -1348,7 +1365,7 @@ play_it_again: RX_MATCH_TAINTED_on(rx); TAINT_IF(RX_MATCH_TAINTED(rx)); if (gimme == G_ARRAY) { - const I32 nparens = rx->nparens; + const I32 nparens = RX_NPARENS(rx); I32 i = (global && !nparens) ? 1 : 0; SPAGAIN; /* EVAL blocks could move the stack. */ @@ -1356,10 +1373,10 @@ play_it_again: EXTEND_MORTAL(nparens + i); for (i = !i; i <= nparens; i++) { PUSHs(sv_newmortal()); - if ((rx->offs[i].start != -1) && rx->offs[i].end != -1 ) { - const I32 len = rx->offs[i].end - rx->offs[i].start; - s = rx->offs[i].start + truebase; - if (rx->offs[i].end < 0 || rx->offs[i].start < 0 || + if ((RX_OFFS(rx)[i].start != -1) && RX_OFFS(rx)[i].end != -1 ) { + const I32 len = RX_OFFS(rx)[i].end - RX_OFFS(rx)[i].start; + s = RX_OFFS(rx)[i].start + truebase; + if (RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0 || len < 0 || len > strend - s) DIE(aTHX_ "panic: pp_match start/end pointers"); sv_setpvn(*SP, s, len); @@ -1380,17 +1397,17 @@ play_it_again: mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob, NULL, 0); } - if (rx->offs[0].start != -1) { - mg->mg_len = rx->offs[0].end; - if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end) + if (RX_OFFS(rx)[0].start != -1) { + mg->mg_len = RX_OFFS(rx)[0].end; + if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end) mg->mg_flags |= MGf_MINMATCH; else mg->mg_flags &= ~MGf_MINMATCH; } } - had_zerolen = (rx->offs[0].start != -1 - && (rx->offs[0].start + rx->gofs - == (UV)rx->offs[0].end)); + had_zerolen = (RX_OFFS(rx)[0].start != -1 + && (RX_OFFS(rx)[0].start + RX_GOFS(rx) + == (UV)RX_OFFS(rx)[0].end)); PUTBACK; /* EVAL blocks may use stack */ r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST; goto play_it_again; @@ -1415,9 +1432,9 @@ play_it_again: mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob, NULL, 0); } - if (rx->offs[0].start != -1) { - mg->mg_len = rx->offs[0].end; - if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end) + if (RX_OFFS(rx)[0].start != -1) { + mg->mg_len = RX_OFFS(rx)[0].end; + if (RX_OFFS(rx)[0].start + RX_GOFS(rx) == (UV)RX_OFFS(rx)[0].end) mg->mg_flags |= MGf_MINMATCH; else mg->mg_flags &= ~MGf_MINMATCH; @@ -1440,24 +1457,24 @@ yup: /* Confirmed by INTUIT */ #endif } if (RX_MATCH_COPIED(rx)) - Safefree(rx->subbeg); + Safefree(RX_SUBBEG(rx)); RX_MATCH_COPIED_off(rx); - rx->subbeg = NULL; + RX_SUBBEG(rx) = NULL; if (global) { /* FIXME - should rx->subbeg be const char *? */ - rx->subbeg = (char *) truebase; - rx->offs[0].start = s - truebase; + RX_SUBBEG(rx) = (char *) truebase; + RX_OFFS(rx)[0].start = s - truebase; if (RX_MATCH_UTF8(rx)) { - char * const t = (char*)utf8_hop((U8*)s, rx->minlenret); - rx->offs[0].end = t - truebase; + char * const t = (char*)utf8_hop((U8*)s, RX_MINLENRET(rx)); + RX_OFFS(rx)[0].end = t - truebase; } else { - rx->offs[0].end = s - truebase + rx->minlenret; + RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx); } - rx->sublen = strend - truebase; + RX_SUBLEN(rx) = strend - truebase; goto gotcha; } - if (PL_sawampersand || rx->extflags & RXf_PMf_KEEPCOPY) { + if (PL_sawampersand || RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) { I32 off; #ifdef PERL_OLD_COPY_ON_WRITE if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) { @@ -1467,30 +1484,31 @@ yup: /* Confirmed by INTUIT */ (int) SvTYPE(TARG), (void*)truebase, (void*)t, (int)(t-truebase)); } - rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG); - rx->subbeg = (char *) SvPVX_const(rx->saved_copy) + (t - truebase); - assert (SvPOKp(rx->saved_copy)); + RX_SAVED_COPY(rx) = sv_setsv_cow(RX_SAVED_COPY(rx), TARG); + RX_SUBBEG(rx) + = (char *) SvPVX_const(RX_SAVED_COPY(rx)) + (t - truebase); + assert (SvPOKp(RX_SAVED_COPY(rx))); } else #endif { - rx->subbeg = savepvn(t, strend - t); + RX_SUBBEG(rx) = savepvn(t, strend - t); #ifdef PERL_OLD_COPY_ON_WRITE - rx->saved_copy = NULL; + RX_SAVED_COPY(rx) = NULL; #endif } - rx->sublen = strend - t; + RX_SUBLEN(rx) = strend - t; RX_MATCH_COPIED_on(rx); - off = rx->offs[0].start = s - t; - rx->offs[0].end = off + rx->minlenret; + off = RX_OFFS(rx)[0].start = s - t; + RX_OFFS(rx)[0].end = off + RX_MINLENRET(rx); } else { /* startp/endp are used by @- @+. */ - rx->offs[0].start = s - truebase; - rx->offs[0].end = s - truebase + rx->minlenret; + RX_OFFS(rx)[0].start = s - truebase; + RX_OFFS(rx)[0].end = s - truebase + RX_MINLENRET(rx); } - /* including rx->nparens in the below code seems highly suspicious. + /* including RX_NPARENS(rx) in the below code seems highly suspicious. -dmq */ - rx->nparens = rx->lastparen = rx->lastcloseparen = 0; /* used by @-, @+, and $^N */ + RX_NPARENS(rx) = RX_LASTPAREN(rx) = RX_LASTCLOSEPAREN(rx) = 0; /* used by @-, @+, and $^N */ LEAVE_SCOPE(oldsave); RETPUSHYES; @@ -1943,6 +1961,15 @@ PP(pp_iter) *itersvp = newSViv(cx->blk_loop.iterix++); SvREFCNT_dec(oldsv); } + + /* Handle end of range at IV_MAX */ + if ((cx->blk_loop.iterix == IV_MIN) && + (cx->blk_loop.itermax == IV_MAX)) + { + cx->blk_loop.iterix++; + cx->blk_loop.itermax++; + } + RETPUSHYES; } @@ -2024,7 +2051,7 @@ PP(pp_subst) I32 maxiters; register I32 i; bool once; - bool rxtainted; + U8 rxtainted; char *orig; I32 r_flags; register REGEXP *rx = PM_GETRE(pm); @@ -2033,6 +2060,7 @@ PP(pp_subst) const I32 oldsave = PL_savestack_ix; STRLEN slen; bool doutf8 = FALSE; + I32 matched; #ifdef PERL_OLD_COPY_ON_WRITE bool is_cow; #endif @@ -2071,7 +2099,7 @@ PP(pp_subst) s = SvPV_mutable(TARG, len); if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV) force_on_match = 1; - rxtainted = ((rx->extflags & RXf_TAINTED) || + rxtainted = ((RX_EXTFLAGS(rx) & RXf_TAINTED) || (PL_tainted && (pm->op_pmflags & PMf_RETAINT))); if (PL_tainted) rxtainted |= 2; @@ -2089,29 +2117,29 @@ PP(pp_subst) position, once with zero-length, second time with non-zero. */ - if (!rx->prelen && PL_curpm) { + if (!RX_PRELEN(rx) && PL_curpm) { pm = PL_curpm; rx = PM_GETRE(pm); } - r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand - || (rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) ) + r_flags = (RX_NPARENS(rx) || SvTEMP(TARG) || PL_sawampersand + || (RX_EXTFLAGS(rx) & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)) ) ? REXEC_COPY_STR : 0; if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; orig = m = s; - if (rx->extflags & RXf_USE_INTUIT) { + if (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) { PL_bostr = orig; s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL); if (!s) goto nope; /* How to do it in subst? */ -/* if ( (rx->extflags & RXf_CHECK_ALL) +/* if ( (RX_EXTFLAGS(rx) & RXf_CHECK_ALL) && !PL_sawampersand - && !(rx->extflags & RXf_KEEPCOPY) - && ((rx->extflags & RXf_NOSCAN) - || !((rx->extflags & RXf_INTUIT_TAIL) + && !(RX_EXTFLAGS(rx) & RXf_KEEPCOPY) + && ((RX_EXTFLAGS(rx) & RXf_NOSCAN) + || !((RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL) && (r_flags & REXEC_SCREAM)))) goto yup; */ @@ -2119,7 +2147,8 @@ PP(pp_subst) /* only replace once? */ once = !(rpm->op_pmflags & PMf_GLOBAL); - + matched = CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, + r_flags | REXEC_CHECKED); /* known replacement string? */ if (dstr) { /* replacement needing upgrading? */ @@ -2148,11 +2177,10 @@ PP(pp_subst) #ifdef PERL_OLD_COPY_ON_WRITE && !is_cow #endif - && (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR)) - && !(rx->extflags & RXf_LOOKBEHIND_SEEN) + && (I32)clen <= RX_MINLENRET(rx) && (once || !(r_flags & REXEC_COPY_STR)) + && !(RX_EXTFLAGS(rx) & RXf_LOOKBEHIND_SEEN) && (!doutf8 || SvUTF8(TARG))) { - if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, - r_flags | REXEC_CHECKED)) + if (!matched) { SPAGAIN; PUSHs(&PL_sv_no); @@ -2175,8 +2203,8 @@ PP(pp_subst) SvSCREAM_off(TARG); /* disable possible screamer */ if (once) { rxtainted |= RX_MATCH_TAINTED(rx); - m = orig + rx->offs[0].start; - d = orig + rx->offs[0].end; + m = orig + RX_OFFS(rx)[0].start; + d = orig + RX_OFFS(rx)[0].end; s = orig; if (m - s > strend - d) { /* faster to shorten from end */ if (clen) { @@ -2194,10 +2222,8 @@ PP(pp_subst) else if ((i = m - s)) { /* faster from front */ d -= clen; m = d; + Move(s, d - i, i, char); sv_chop(TARG, d-i); - s += i; - while (i--) - *--d = *--s; if (clen) Copy(c, m, clen, char); } @@ -2218,7 +2244,7 @@ PP(pp_subst) if (iters++ > maxiters) DIE(aTHX_ "Substitution loop"); rxtainted |= RX_MATCH_TAINTED(rx); - m = rx->offs[0].start + orig; + m = RX_OFFS(rx)[0].start + orig; if ((i = m - s)) { if (s != d) Move(s, d, i, char); @@ -2228,7 +2254,7 @@ PP(pp_subst) Copy(c, d, clen, char); d += clen; } - s = rx->offs[0].end + orig; + s = RX_OFFS(rx)[0].end + orig; } while (CALLREGEXEC(rx, s, strend, orig, s == m, TARG, NULL, /* don't match same null twice */ @@ -2240,7 +2266,7 @@ PP(pp_subst) } TAINT_IF(rxtainted & 1); SPAGAIN; - PUSHs(sv_2mortal(newSViv((I32)iters))); + mPUSHi((I32)iters); } (void)SvPOK_only_UTF8(TARG); TAINT_IF(rxtainted); @@ -2256,8 +2282,7 @@ PP(pp_subst) RETURN; } - if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL, - r_flags | REXEC_CHECKED)) + if (matched) { if (force_on_match) { force_on_match = 0; @@ -2268,10 +2293,8 @@ PP(pp_subst) have_a_cow: #endif rxtainted |= RX_MATCH_TAINTED(rx); - dstr = newSVpvn(m, s-m); + dstr = newSVpvn_utf8(m, s-m, DO_UTF8(TARG)); SAVEFREESV(dstr); - if (DO_UTF8(TARG)) - SvUTF8_on(dstr); PL_curpm = pm; if (!c) { register PERL_CONTEXT *cx; @@ -2284,19 +2307,19 @@ PP(pp_subst) if (iters++ > maxiters) DIE(aTHX_ "Substitution loop"); rxtainted |= RX_MATCH_TAINTED(rx); - if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) { + if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) { m = s; s = orig; - orig = rx->subbeg; + orig = RX_SUBBEG(rx); s = orig + (m - s); strend = s + (strend - m); } - m = rx->offs[0].start + orig; + m = RX_OFFS(rx)[0].start + orig; if (doutf8 && !SvUTF8(dstr)) sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv); else sv_catpvn(dstr, s, m-s); - s = rx->offs[0].end + orig; + s = RX_OFFS(rx)[0].end + orig; if (clen) sv_catpvn(dstr, c, clen); if (once) @@ -2329,7 +2352,7 @@ PP(pp_subst) TAINT_IF(rxtainted & 1); SPAGAIN; - PUSHs(sv_2mortal(newSViv((I32)iters))); + mPUSHi((I32)iters); (void)SvPOK_only(TARG); if (doutf8) @@ -2482,7 +2505,7 @@ PP(pp_leavesublv) TAINT_NOT; - if (cx->blk_sub.lval & OPpENTERSUB_INARGS) { + if (CxLVAL(cx) & OPpENTERSUB_INARGS) { /* We are an argument to a function or grep(). * This kind of lvalueness was legal before lvalue * subroutines too, so be backward compatible: @@ -2509,7 +2532,7 @@ PP(pp_leavesublv) } } } - else if (cx->blk_sub.lval) { /* Leave it as it is if we can. */ + else if (CxLVAL(cx)) { /* Leave it as it is if we can. */ /* Here we go for robustness, not for speed, so we change all * the refcounts so the caller gets a live guy. Cannot set * TEMP, so sv_2mortal is out of question. */ @@ -2807,7 +2830,7 @@ try_autoload: * stuff so that __WARN__ handlers can safely dounwind() * if they want to */ - if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION) + if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION) && !(PERLDB_SUB && cv == GvCV(PL_DBsub))) sub_crush_depth(cv); #if 0 @@ -2939,13 +2962,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) if (!SvOK(sv)) { if (SvREADONLY(sv)) Perl_croak(aTHX_ PL_no_modify); - if (SvTYPE(sv) < SVt_RV) - sv_upgrade(sv, SVt_RV); - else if (SvTYPE(sv) >= SVt_PV) { - SvPV_free(sv); - SvLEN_set(sv, 0); - SvCUR_set(sv, 0); - } + prepare_SV_for_RV(sv); switch (to_what) { case OPpDEREF_SV: SvRV_set(sv, newSV(0));