summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2015-10-25 18:28:14 +0000
committerDavid Mitchell <davem@iabyn.com>2015-11-10 13:52:34 +0000
commit20e9643135b0912e2449f038a0ec1c0e84657f3f (patch)
treef30b419cd8f5a714a3479cc3fc13bf303549e955
parent4c2c31284ee422eca648d182e07205f67a173227 (diff)
downloadperl-20e9643135b0912e2449f038a0ec1c0e84657f3f.tar.gz
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
-rw-r--r--opcode.h7
-rw-r--r--pp.c80
-rw-r--r--pp_proto.h1
-rwxr-xr-xregen/opcode.pl3
4 files changed, 69 insertions, 22 deletions
diff --git a/opcode.h b/opcode.h
index 01ed42d958..e711e65ac1 100644
--- 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 2305bbd72b..35a5f26552 100644
--- 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 440e7899cb..f919313ed1 100644
--- 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 3c5c8cfbab..82454bbb48 100755
--- 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)],