split pp_postdec() from pp_postinc() and improve

pp_postinc() handles both $x++ and $x-- (and the integer variants
pp_i_postinc/dec). Split it into two separate functions, as handling
both inc and dec in the same function requires 3 extra conditionals.

At the same time make the code more efficient.

As currently written it:
1) checked for "bad" SVs (such as read-only) and croaked;
2) did a sv_setsv(TARG, TOPs) to return a copy of the original value;
2) checked for a IOK-only SV and if so, directly incremented the IVX slot;
3) else called out to sv_inc/dec() to handle the more complex cases.

This commit combines the checks in (1) and (3) into one single big
check of flags, and for the simple integer case, skips 2) and does
a more efficient SETi() instead.
For the non-simple case, both pp_postinc() and pp_postdec() now call a
common static function to handle everything else.

Porting/bench.pl shows the following raw numbers for
'$y = $x++' ($x and $y lexical and holding integers):

         before    after
         ------    -----
    Ir    306.0    223.0
    Dr    106.0     82.0
    Dw     51.0     44.0
  COND     48.0     33.0
   IND      8.0      6.0

COND_m      1.9      0.0
 IND_m      4.0      4.0

diff --git a/opcode.h b/opcode.h
index 01ed42d..e711e65 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -24,8 +24,7 @@
 #define Perl_pp_i_preinc Perl_pp_preinc
 #define Perl_pp_i_predec Perl_pp_predec
 #define Perl_pp_i_postinc Perl_pp_postinc
-#define Perl_pp_postdec Perl_pp_postinc
-#define Perl_pp_i_postdec Perl_pp_postinc
+#define Perl_pp_i_postdec Perl_pp_postdec
 #define Perl_pp_slt Perl_pp_sle
 #define Perl_pp_sgt Perl_pp_sle
 #define Perl_pp_sge Perl_pp_sle
@@ -1016,8 +1015,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        Perl_pp_i_predec,       /* implemented by Perl_pp_predec */
        Perl_pp_postinc,
        Perl_pp_i_postinc,      /* implemented by Perl_pp_postinc */
-       Perl_pp_postdec,        /* implemented by Perl_pp_postinc */
-       Perl_pp_i_postdec,      /* implemented by Perl_pp_postinc */
+       Perl_pp_postdec,
+       Perl_pp_i_postdec,      /* implemented by Perl_pp_postdec */
        Perl_pp_pow,
        Perl_pp_multiply,
        Perl_pp_i_multiply,

diff --git a/pp.c b/pp.c
index 2305bbd..35a5f26 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1072,28 +1072,23 @@ PP(pp_undef)
 }
 
 
-/* also used for: pp_i_postdec() pp_i_postinc() pp_postdec() */
+/* common "slow" code for pp_postinc and pp_postdec */
 
-PP(pp_postinc)
+static OP *
+S_postincdec_common(pTHX_ SV *sv, SV *targ)
 {
-    dSP; dTARGET;
+    dSP;
     const bool inc =
        PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
-    if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
-       Perl_croak_no_modify();
-    if (SvROK(TOPs))
+
+    if (SvROK(sv))
        TARG = sv_newmortal();
-    sv_setsv(TARG, TOPs);
-    if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
-        && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
-    {
-       SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1));
-       SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
-    }
-    else if (inc)
-       sv_inc_nomg(TOPs);
-    else sv_dec_nomg(TOPs);
-    SvSETMAGIC(TOPs);
+    sv_setsv(TARG, sv);
+    if (inc)
+       sv_inc_nomg(sv);
+    else
+        sv_dec_nomg(sv);
+    SvSETMAGIC(sv);
     /* special case for undef: see thread at 2003-03/msg00536.html in archive */
     if (inc && !SvOK(TARG))
        sv_setiv(TARG, 0);
@@ -1101,6 +1096,57 @@ PP(pp_postinc)
     return NORMAL;
 }
 
+
+/* also used for: pp_i_postinc() */
+
+PP(pp_postinc)
+{
+    dSP; dTARGET;
+    SV *sv = TOPs;
+
+    /* special-case sv being a simple integer */
+    if (LIKELY(((sv->sv_flags &
+                        (SVf_THINKFIRST|SVs_GMG|SVf_IVisUV|
+                         SVf_IOK|SVf_NOK|SVf_POK|SVp_NOK|SVp_POK|SVf_ROK))
+                == SVf_IOK))
+        && SvIVX(sv) != IV_MAX)
+    {
+        IV iv = SvIVX(sv);
+       SvIV_set(sv,  iv + 1);
+        TARGi(iv, 0); /* arg not GMG, so can't be tainted */
+        SETs(TARG);
+        return NORMAL;
+    }
+
+    return S_postincdec_common(aTHX_ sv, TARG);
+}
+
+
+/* also used for: pp_i_postdec() */
+
+PP(pp_postdec)
+{
+    dSP; dTARGET;
+    SV *sv = TOPs;
+
+    /* special-case sv being a simple integer */
+    if (LIKELY(((sv->sv_flags &
+                        (SVf_THINKFIRST|SVs_GMG|SVf_IVisUV|
+                         SVf_IOK|SVf_NOK|SVf_POK|SVp_NOK|SVp_POK|SVf_ROK))
+                == SVf_IOK))
+        && SvIVX(sv) != IV_MIN)
+    {
+        IV iv = SvIVX(sv);
+       SvIV_set(sv,  iv - 1);
+        TARGi(iv, 0); /* arg not GMG, so can't be tainted */
+        SETs(TARG);
+        return NORMAL;
+    }
+
+    return S_postincdec_common(aTHX_ sv, TARG);
+}
+
+
 /* Ordinary operators. */
 
 PP(pp_pow)

diff --git a/pp_proto.h b/pp_proto.h
index 440e789..f919313 100644 (file)
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -184,6 +184,7 @@ PERL_CALLCONV OP *Perl_pp_padrange(pTHX);
 PERL_CALLCONV OP *Perl_pp_padsv(pTHX);
 PERL_CALLCONV OP *Perl_pp_pipe_op(pTHX);
 PERL_CALLCONV OP *Perl_pp_pos(pTHX);
+PERL_CALLCONV OP *Perl_pp_postdec(pTHX);
 PERL_CALLCONV OP *Perl_pp_postinc(pTHX);
 PERL_CALLCONV OP *Perl_pp_pow(pTHX);
 PERL_CALLCONV OP *Perl_pp_predec(pTHX);

diff --git a/regen/opcode.pl b/regen/opcode.pl
index 3c5c8cf..82454bb 100755 (executable)
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -132,7 +132,8 @@ my @raw_alias = (
                 Perl_pp_bind => {connect => '#ifdef HAS_SOCKET'},
                 Perl_pp_preinc => ['i_preinc'],
                 Perl_pp_predec => ['i_predec'],
-                Perl_pp_postinc => ['i_postinc', 'postdec', 'i_postdec'],
+                Perl_pp_postinc => ['i_postinc'],
+                Perl_pp_postdec => ['i_postdec'],
                 Perl_pp_ehostent => [qw(enetent eprotoent eservent
                                         spwent epwent sgrent egrent)],
                 Perl_pp_shostent => [qw(snetent sprotoent sservent)],