diff options
-rw-r--r-- | opcode.h | 7 | ||||
-rw-r--r-- | pp_hot.c | 47 | ||||
-rw-r--r-- | pp_proto.h | 1 | ||||
-rwxr-xr-x | regen/opcode.pl | 3 | ||||
-rw-r--r-- | t/perf/benchmarks | 22 |
5 files changed, 61 insertions, 19 deletions
@@ -22,8 +22,7 @@ #define Perl_pp_chomp Perl_pp_chop #define Perl_pp_schomp Perl_pp_schop #define Perl_pp_i_preinc Perl_pp_preinc -#define Perl_pp_predec Perl_pp_preinc -#define Perl_pp_i_predec 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 @@ -1013,8 +1012,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_pos, Perl_pp_preinc, Perl_pp_i_preinc, /* implemented by Perl_pp_preinc */ - Perl_pp_predec, /* implemented by Perl_pp_preinc */ - Perl_pp_i_predec, /* implemented by Perl_pp_preinc */ + Perl_pp_predec, + 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 */ @@ -465,25 +465,44 @@ PP(pp_eq) } -/* also used for: pp_i_predec() pp_i_preinc() pp_predec() */ +/* also used for: pp_i_preinc() */ PP(pp_preinc) { - dSP; - const bool inc = - PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC; - if (UNLIKELY(SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))) - Perl_croak_no_modify(); - if (LIKELY(!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) - && SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN)) + SV *sv = *PL_stack_sp; + + 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) + { + SvIV_set(sv, SvIVX(sv) + 1); + } + else /* Do all the PERL_PRESERVE_IVUV and hard cases in sv_inc */ + sv_inc(sv); + SvSETMAGIC(sv); + return NORMAL; +} + + +/* also used for: pp_i_predec() */ + +PP(pp_predec) +{ + SV *sv = *PL_stack_sp; + + 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) { - SvIV_set(TOPs, SvIVX(TOPs) + (inc ? 1 : -1)); - SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); + SvIV_set(sv, SvIVX(sv) - 1); } - else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */ - if (inc) sv_inc(TOPs); - else sv_dec(TOPs); - SvSETMAGIC(TOPs); + else /* Do all the PERL_PRESERVE_IVUV and hard cases in sv_dec */ + sv_dec(sv); + SvSETMAGIC(sv); return NORMAL; } diff --git a/pp_proto.h b/pp_proto.h index 96934ffc6f..440e7899cb 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -186,6 +186,7 @@ PERL_CALLCONV OP *Perl_pp_pipe_op(pTHX); PERL_CALLCONV OP *Perl_pp_pos(pTHX); PERL_CALLCONV OP *Perl_pp_postinc(pTHX); PERL_CALLCONV OP *Perl_pp_pow(pTHX); +PERL_CALLCONV OP *Perl_pp_predec(pTHX); PERL_CALLCONV OP *Perl_pp_preinc(pTHX); PERL_CALLCONV OP *Perl_pp_print(pTHX); PERL_CALLCONV OP *Perl_pp_prototype(pTHX); diff --git a/regen/opcode.pl b/regen/opcode.pl index 50029bd1ae..3c5c8cfbab 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -130,7 +130,8 @@ my @raw_alias = ( Perl_pp_chop => [qw(chop chomp)], Perl_pp_schop => [qw(schop schomp)], Perl_pp_bind => {connect => '#ifdef HAS_SOCKET'}, - Perl_pp_preinc => ['i_preinc', 'predec', 'i_predec'], + Perl_pp_preinc => ['i_preinc'], + Perl_pp_predec => ['i_predec'], Perl_pp_postinc => ['i_postinc', 'postdec', 'i_postdec'], Perl_pp_ehostent => [qw(enetent eprotoent eservent spwent epwent sgrent egrent)], diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 223c81f656..ce8f19e6a0 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -808,4 +808,26 @@ code => '$z = $x * $y', }, + 'expr::arith::preinc' => { + desc => '++$x', + setup => 'my $x = 1;', + code => '++$x', + }, + 'expr::arith::predec' => { + desc => '--$x', + setup => 'my $x = 1;', + code => '--$x', + }, + 'expr::arith::postinc' => { + desc => '$x++', + setup => 'my $x = 1; my $y', + code => '$y = $x++', # scalar context so not optimised to ++$x + }, + 'expr::arith::postdec' => { + desc => '$x--', + setup => 'my $x = 1; my $y', + code => '$y = $x--', # scalar context so not optimised to --$x + + }, + ]; |