Math::BigInt v1.74, Math::BigRat v0.14, bignum v0.16

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 3a89b6f..e41ee3d 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -16,6 +16,19 @@
  *                     Fire, Foes!  Awake!
  */
 
+/* This file contains 'hot' pp ("push/pop") functions that
+ * execute the opcodes that make up a perl program. A typical pp function
+ * expects to find its arguments on the stack, and usually pushes its
+ * results onto the stack, hence the 'pp' terminology. Each OP structure
+ * contains a pointer to the relevant pp_foo() function.
+ *
+ * By 'hot', we mean common ops whose execution speed is critical.
+ * By gathering them together into a single file, we encourage
+ * CPU cache hits on hot code. Also it could be taken as a warning not to
+ * change any code in this file unless you're sure it won't affect
+ * performance.
+ */
+
 #include "EXTERN.h"
 #define PERL_IN_PP_HOT_C
 #include "perl.h"
@@ -231,7 +244,7 @@ PP(pp_eq)
 {
     dSP; tryAMAGICbinSET(eq,0);
 #ifndef NV_PRESERVES_UV
-    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+    if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
        SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s)));
        RETURN;
@@ -1261,11 +1274,6 @@ PP(pp_match)
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
 
-    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
-       SAVEINT(PL_multiline);
-       PL_multiline = pm->op_pmflags & PMf_MULTILINE;
-    }
-
 play_it_again:
     if (global && rx->startp[0] != -1) {
        t = s = rx->endp[0] + truebase;
@@ -1524,7 +1532,7 @@ Perl_do_readline(pTHX)
            /* undef TARG, and push that undefined value */
            if (type != OP_RCATLINE) {
                SV_CHECK_THINKFIRST_COW_DROP(TARG);
-               (void)SvOK_off(TARG);
+               SvOK_off(TARG);
            }
            PUSHTARG;
        }
@@ -1590,7 +1598,7 @@ Perl_do_readline(pTHX)
            if (gimme == G_SCALAR) {
                if (type != OP_RCATLINE) {
                    SV_CHECK_THINKFIRST_COW_DROP(TARG);
-                   (void)SvOK_off(TARG);
+                   SvOK_off(TARG);
                }
                SPAGAIN;
                PUSHTARG;
@@ -1824,7 +1832,7 @@ PP(pp_iter)
 {
     dSP;
     register PERL_CONTEXT *cx;
-    SV* sv;
+    SV *sv, *oldsv;
     AV* av;
     SV **itersvp;
 
@@ -1852,8 +1860,9 @@ PP(pp_iter)
                    /* we need a fresh SV every time so that loop body sees a
                     * completely new SV for closures/references to work as
                     * they used to */
-                   SvREFCNT_dec(*itersvp);
+                   oldsv = *itersvp;
                    *itersvp = newSVsv(cur);
+                   SvREFCNT_dec(oldsv);
                }
                if (strEQ(SvPVX(cur), max))
                    sv_setiv(cur, 0); /* terminate next time */
@@ -1877,28 +1886,47 @@ PP(pp_iter)
            /* we need a fresh SV every time so that loop body sees a
             * completely new SV for closures/references to work as they
             * used to */
-           SvREFCNT_dec(*itersvp);
+           oldsv = *itersvp;
            *itersvp = newSViv(cx->blk_loop.iterix++);
+           SvREFCNT_dec(oldsv);
        }
        RETPUSHYES;
     }
 
     /* iterate array */
-    if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
-       RETPUSHNO;
-
-    SvREFCNT_dec(*itersvp);
+    if (PL_op->op_private & OPpITER_REVERSED) {
+       /* In reverse, use itermax as the min :-)  */
+       if (cx->blk_loop.iterix <= cx->blk_loop.itermax)
+           RETPUSHNO;
 
-    if (SvMAGICAL(av) || AvREIFY(av)) {
-       SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
-       if (svp)
-           sv = *svp;
-       else
-           sv = Nullsv;
+       if (SvMAGICAL(av) || AvREIFY(av)) {
+           SV **svp = av_fetch(av, cx->blk_loop.iterix--, FALSE);
+           if (svp)
+               sv = *svp;
+           else
+               sv = Nullsv;
+       }
+       else {
+           sv = AvARRAY(av)[cx->blk_loop.iterix--];
+       }
     }
     else {
-       sv = AvARRAY(av)[++cx->blk_loop.iterix];
+       if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp :
+                                   AvFILL(av)))
+           RETPUSHNO;
+
+       if (SvMAGICAL(av) || AvREIFY(av)) {
+           SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
+           if (svp)
+               sv = *svp;
+           else
+               sv = Nullsv;
+       }
+       else {
+           sv = AvARRAY(av)[++cx->blk_loop.iterix];
+       }
     }
+
     if (sv && SvREFCNT(sv) == 0) {
        *itersvp = Nullsv;
        Perl_croak(aTHX_ "Use of freed value in iteration");
@@ -1928,7 +1956,10 @@ PP(pp_iter)
        sv = (SV*)lv;
     }
 
+    oldsv = *itersvp;
     *itersvp = SvREFCNT_inc(sv);
+    SvREFCNT_dec(oldsv);
+
     RETPUSHYES;
 }
 
@@ -2020,10 +2051,7 @@ PP(pp_subst)
               ? REXEC_COPY_STR : 0;
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
-    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
-       SAVEINT(PL_multiline);
-       PL_multiline = pm->op_pmflags & PMf_MULTILINE;
-    }
+
     orig = m = s;
     if (rx->reganch & RE_USE_INTUIT) {
        PL_bostr = orig;
@@ -2246,7 +2274,7 @@ PP(pp_subst)
        } else
 #endif
        {
-           (void)SvOOK_off(TARG);
+           SvOOK_off(TARG);
            if (SvLEN(TARG))
                Safefree(SvPVX(TARG));
        }
@@ -2386,7 +2414,7 @@ PP(pp_leavesub)
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);
-    return pop_return();
+    return cx->blk_sub.retop;
 }
 
 /* This duplicates the above code because the above code must not
@@ -2544,7 +2572,7 @@ PP(pp_leavesublv)
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);
-    return pop_return();
+    return cx->blk_sub.retop;
 }
 
 
@@ -2674,9 +2702,9 @@ PP(pp_entersub)
        dMARK;
        register I32 items = SP - MARK;
        AV* padlist = CvPADLIST(cv);
-       push_return(PL_op->op_next);
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
+       cx->blk_sub.retop = PL_op->op_next;
        CvDEPTH(cv)++;
        /* XXX This would be a natural place to set C<PL_compcv = cv> so
         * that eval'' ops within this sub know the correct lexical space.
@@ -2928,7 +2956,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
        if (SvTYPE(sv) < SVt_RV)
            sv_upgrade(sv, SVt_RV);
        else if (SvTYPE(sv) >= SVt_PV) {
-           (void)SvOOK_off(sv);
+           SvOOK_off(sv);
            Safefree(SvPVX(sv));
            SvLEN(sv) = SvCUR(sv) = 0;
        }