X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=7a83ee7040279e2ea12b7f66768fc7e4ed518915;hb=0295a53a2a0d7b08c078ea9d195ec919c7df2a35;hp=3292332642c7cd806d1218b38fa275bfea27b675;hpb=b37c2d43c8bccbefe3985273e9661833102148d0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 3292332..7a83ee7 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -120,6 +120,12 @@ PP(pp_sassign) SV * const temp = left; left = right; right = temp; } + else if (PL_op->op_private & OPpASSIGN_STATE) { + if (SvPADSTALE(right)) + SvPADSTALE_off(right); + else + RETURN; /* ignore assignment */ + } if (PL_tainting && PL_tainted && !SvTAINTED(left)) TAINT_NOT; if (PL_op->op_private & OPpASSIGN_CV_TO_GV) { @@ -208,7 +214,7 @@ PP(pp_concat) dPOPTOPssrl; bool lbyte; STRLEN rlen; - const char *rpv = 0; + const char *rpv = NULL; bool rbyte = FALSE; bool rcopied = FALSE; @@ -273,7 +279,8 @@ PP(pp_padsv) XPUSHs(TARG); if (PL_op->op_flags & OPf_MOD) { if (PL_op->op_private & OPpLVAL_INTRO) - SAVECLEARSV(PAD_SVl(PL_op->op_targ)); + if (!(PL_op->op_private & OPpPAD_STATE)) + SAVECLEARSV(PAD_SVl(PL_op->op_targ)); if (PL_op->op_private & OPpDEREF) { PUTBACK; vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF); @@ -350,21 +357,27 @@ PP(pp_eq) ivp = *--SP; } iv = SvIVX(ivp); - if (iv < 0) { + if (iv < 0) /* As uv is a UV, it's >0, so it cannot be == */ SETs(&PL_sv_no); - RETURN; - } - /* we know iv is >= 0 */ - SETs(boolSV((UV)iv == SvUVX(uvp))); + else + /* we know iv is >= 0 */ + SETs(boolSV((UV)iv == SvUVX(uvp))); RETURN; } } } #endif { +#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) + dPOPTOPnnrl; + if (Perl_isnan(left) || Perl_isnan(right)) + RETSETNO; + SETs(boolSV(left == right)); +#else dPOPnv; SETs(boolSV(TOPn == value)); +#endif RETURN; } } @@ -1067,6 +1080,12 @@ PP(pp_aassign) } } } + if (PL_op->op_private & OPpASSIGN_STATE) { + if (SvPADSTALE(*firstlelem)) + SvPADSTALE_off(*firstlelem); + else + RETURN; /* ignore assignment */ + } relem = firstrelem; lelem = firstlelem; @@ -1405,8 +1424,12 @@ play_it_again: if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) mg = mg_find(TARG, PERL_MAGIC_regex_global); if (!mg) { - sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0); - mg = mg_find(TARG, PERL_MAGIC_regex_global); +#ifdef PERL_OLD_COPY_ON_WRITE + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG, 0); +#endif + mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global, + &PL_vtbl_mglob, NULL, 0); } if (rx->startp[0] != -1) { mg->mg_len = rx->endp[0]; @@ -1435,8 +1458,12 @@ play_it_again: else mg = NULL; if (!mg) { - sv_magic(TARG, NULL, PERL_MAGIC_regex_global, NULL, 0); - mg = mg_find(TARG, PERL_MAGIC_regex_global); +#ifdef PERL_OLD_COPY_ON_WRITE + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG, 0); +#endif + mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global, + &PL_vtbl_mglob, NULL, 0); } if (rx->startp[0] != -1) { mg->mg_len = rx->endp[0]; @@ -1701,16 +1728,17 @@ Perl_do_readline(pTHX) continue; } } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */ - const U8 * const s = (const U8*)SvPVX_const(sv) + offset; - const STRLEN len = SvCUR(sv) - offset; - const U8 *f; - - if (ckWARN(WARN_UTF8) && - !is_utf8_string_loc(s, len, &f)) - /* Emulate :encoding(utf8) warning in the same case. */ - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "utf8 \"\\x%02X\" does not map to Unicode", - f < (U8*)SvEND(sv) ? *f : 0); + if (ckWARN(WARN_UTF8)) { + const U8 * const s = (const U8*)SvPVX_const(sv) + offset; + const STRLEN len = SvCUR(sv) - offset; + const U8 *f; + + if (!is_utf8_string_loc(s, len, &f)) + /* Emulate :encoding(utf8) warning in the same case. */ + Perl_warner(aTHX_ packWARN(WARN_UTF8), + "utf8 \"\\x%02X\" does not map to Unicode", + f < (U8*)SvEND(sv) ? *f : 0); + } } if (gimme == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { @@ -1763,32 +1791,28 @@ PP(pp_helem) const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0; I32 preeminent = 0; - if (SvTYPE(hv) == SVt_PVHV) { - if (PL_op->op_private & OPpLVAL_INTRO) { - MAGIC *mg; - HV *stash; - /* does the element we're localizing already exist? */ - preeminent = - /* can we determine whether it exists? */ - ( !SvRMAGICAL(hv) - || mg_find((SV*)hv, PERL_MAGIC_env) - || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied)) - /* Try to preserve the existenceness of a tied hash - * element by using EXISTS and DELETE if possible. - * Fallback to FETCH and STORE otherwise */ - && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg)))) - && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) - && gv_fetchmethod_autoload(stash, "DELETE", TRUE) - ) - ) ? hv_exists_ent(hv, keysv, 0) : 1; - - } - he = hv_fetch_ent(hv, keysv, lval && !defer, hash); - svp = he ? &HeVAL(he) : NULL; - } - else { + if (SvTYPE(hv) != SVt_PVHV) RETPUSHUNDEF; - } + + if (PL_op->op_private & OPpLVAL_INTRO) { + MAGIC *mg; + HV *stash; + /* does the element we're localizing already exist? */ + preeminent = /* can we determine whether it exists? */ + ( !SvRMAGICAL(hv) + || mg_find((SV*)hv, PERL_MAGIC_env) + || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied)) + /* Try to preserve the existenceness of a tied hash + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise */ + && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg)))) + && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) + && gv_fetchmethod_autoload(stash, "DELETE", TRUE) + ) + ) ? hv_exists_ent(hv, keysv, 0) : 1; + } + he = hv_fetch_ent(hv, keysv, lval && !defer, hash); + svp = he ? &HeVAL(he) : NULL; if (lval) { if (!svp || *svp == &PL_sv_undef) { SV* lv; @@ -1813,7 +1837,8 @@ PP(pp_helem) if (!preeminent) { STRLEN keylen; const char * const key = SvPV_const(keysv, keylen); - SAVEDELETE(hv, savepvn(key,keylen), keylen); + SAVEDELETE(hv, savepvn(key,keylen), + SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } else save_helem(hv, keysv, svp); } @@ -2278,13 +2303,13 @@ PP(pp_subst) #endif rxtainted |= RX_MATCH_TAINTED(rx); dstr = newSVpvn(m, s-m); + SAVEFREESV(dstr); if (DO_UTF8(TARG)) SvUTF8_on(dstr); PL_curpm = pm; if (!c) { register PERL_CONTEXT *cx; SPAGAIN; - (void)ReREFCNT_inc(rx); PUSHSUBST(cx); RETURNOP(cPMOP->op_pmreplroot); } @@ -2335,7 +2360,6 @@ PP(pp_subst) SvLEN_set(TARG, SvLEN(dstr)); doutf8 |= DO_UTF8(dstr); SvPV_set(dstr, NULL); - sv_free(dstr); TAINT_IF(rxtainted & 1); SPAGAIN; @@ -2508,7 +2532,7 @@ PP(pp_leavesublv) EXTEND_MORTAL(SP - newsp); for (mark = newsp + 1; mark <= SP; mark++) { if (SvTEMP(*mark)) - /*EMPTY*/; + NOOP; else if (SvFLAGS(*mark) & (SVs_PADTMP | SVf_READONLY)) *mark = sv_mortalcopy(*mark); else { @@ -2645,13 +2669,12 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv) save_item(dbsv); if (!PERLDB_SUB_NN) { - GV *gv = CvGV(cv); + GV * const gv = CvGV(cv); if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || strEQ(GvNAME(gv), "END") || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */ - !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) - && (gv = (GV*)*svp) ))) { + !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) { /* Use GV from the stack as a fallback. */ /* GV is potentially non-unique, or contain different CV. */ SV * const tmp = newRV((SV*)cv); @@ -2770,7 +2793,7 @@ try_autoload: else { sub_name = sv_newmortal(); gv_efullname3(sub_name, gv, NULL); - DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name); + DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name); } } if (!cv) @@ -2910,7 +2933,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) SV* const tmpstr = sv_newmortal(); gv_efullname3(tmpstr, CvGV(cv), NULL); Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"", - tmpstr); + (void*)tmpstr); } } @@ -2926,9 +2949,11 @@ PP(pp_aelem) SV *sv; if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) - Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", elemsv); + Perl_warner(aTHX_ packWARN(WARN_MISC), + "Use of reference \"%"SVf"\" as array index", + (void*)elemsv); if (elem > 0) - elem -= PL_curcop->cop_arybase; + elem -= CopARYBASE_get(PL_curcop); if (SvTYPE(av) != SVt_PVAV) RETPUSHUNDEF; svp = av_fetch(av, elem, lval && !defer); @@ -3082,7 +3107,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) if (!stash) packsv = sv; else { - SV* ref = newSViv(PTR2IV(stash)); + SV* const ref = newSViv(PTR2IV(stash)); hv_store(PL_stashcache, packname, packlen, ref, 0); } goto fetch;