X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=29ec96bedae5494c288a349ba32955c66be66c8b;hb=b6512f489e761186d508cf0b8b7705805cfefc52;hp=bc57075f1da3627770644fceac7bb4992dd40ac2;hpb=acfe0abcedaf592fb4b9cb69ce3468308ae99d91;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index bc57075..29ec96b 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -237,7 +237,8 @@ PP(pp_eq) dSP; tryAMAGICbinSET(eq,0); #ifndef NV_PRESERVES_UV if (SvROK(TOPs) && SvROK(TOPm1s)) { - SETs(boolSV(SvRV(TOPs) == SvRV(TOPm1s))); + SP--; + SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s))); RETURN; } #endif @@ -252,53 +253,40 @@ PP(pp_eq) bool auvok = SvUOK(TOPm1s); bool buvok = SvUOK(TOPs); - if (!auvok && !buvok) { /* ## IV == IV ## */ - IV aiv = SvIVX(TOPm1s); - IV biv = SvIVX(TOPs); + if (auvok == buvok) { /* ## IV == IV or UV == UV ## */ + /* Casting IV to UV before comparison isn't going to matter + on 2s complement. On 1s complement or sign&magnitude + (if we have any of them) it could to make negative zero + differ from normal zero. As I understand it. (Need to + check - is negative zero implementation defined behaviour + anyway?). NWC */ + UV buv = SvUVX(POPs); + UV auv = SvUVX(TOPs); - SP--; - SETs(boolSV(aiv == biv)); - RETURN; - } - if (auvok && buvok) { /* ## UV == UV ## */ - UV auv = SvUVX(TOPm1s); - UV buv = SvUVX(TOPs); - - SP--; SETs(boolSV(auv == buv)); RETURN; } { /* ## Mixed IV,UV ## */ + SV *ivp, *uvp; IV iv; - UV uv; - /* == is commutative so swap if needed (save code) */ + /* == is commutative so doesn't matter which is left or right */ if (auvok) { - /* swap. top of stack (b) is the iv */ - iv = SvIVX(TOPs); - SP--; - if (iv < 0) { - /* As (a) is a UV, it's >0, so it cannot be == */ - SETs(&PL_sv_no); - RETURN; - } - uv = SvUVX(TOPs); - } else { - iv = SvIVX(TOPm1s); - SP--; - if (iv < 0) { - /* As (b) is a UV, it's >0, so it cannot be == */ - SETs(&PL_sv_no); - RETURN; - } - uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */ - } + /* top of stack (b) is the iv */ + ivp = *SP; + uvp = *--SP; + } else { + uvp = *SP; + ivp = *--SP; + } + iv = SvIVX(ivp); + 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 */ - if (uv > (UV) IV_MAX) { - SETs(&PL_sv_no); - RETURN; - } - SETs(boolSV((UV)iv == uv)); + SETs(boolSV((UV)iv == SvUVX(uvp))); RETURN; } } @@ -314,10 +302,10 @@ PP(pp_eq) PP(pp_preinc) { dSP; - if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) + if (SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); - if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && - SvIVX(TOPs) != IV_MAX) + if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) + && SvIVX(TOPs) != IV_MAX) { ++SvIVX(TOPs); SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); @@ -1193,6 +1181,8 @@ PP(pp_qr) register PMOP *pm = cPMOP; SV *rv = sv_newmortal(); SV *sv = newSVrv(rv, "Regexp"); + if (pm->op_pmdynflags & PMdf_TAINTED) + SvTAINTED_on(rv); sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0); RETURNX(PUSHs(rv)); } @@ -1232,7 +1222,7 @@ PP(pp_match) (PL_tainted && (pm->op_pmflags & PMf_RETAINT))); TAINT_NOT; - PL_reg_sv_utf8 = DO_UTF8(TARG); + PL_reg_match_utf8 = DO_UTF8(TARG); if (pm->op_pmdynflags & PMdf_USED) { failure: @@ -1400,7 +1390,7 @@ yup: /* Confirmed by INTUIT */ if (global) { rx->subbeg = truebase; rx->startp[0] = s - truebase; - if (PL_reg_sv_utf8) { + if (PL_reg_match_utf8) { char *t = (char*)utf8_hop((U8*)s, rx->minlen); rx->endp[0] = t - truebase; } @@ -1928,14 +1918,14 @@ PP(pp_subst) rxtainted |= 2; TAINT_NOT; - PL_reg_sv_utf8 = DO_UTF8(TARG); + PL_reg_match_utf8 = DO_UTF8(TARG); force_it: if (!pm || !s) DIE(aTHX_ "panic: pp_subst"); strend = s + len; - slen = PL_reg_sv_utf8 ? utf8_length((U8*)s, (U8*)strend) : len; + slen = PL_reg_match_utf8 ? utf8_length((U8*)s, (U8*)strend) : len; maxiters = 2 * slen + 10; /* We can match twice at each position, once with zero-length, second time with non-zero. */