In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1dc0863403466d6a42cc331d1f6a8f0506b313a3?hp=0c7df90239f4c313f42964755700c2a3c78ec63c>
- Log ----------------------------------------------------------------- commit 1dc0863403466d6a42cc331d1f6a8f0506b313a3 Author: Father Chrysostomos <[email protected]> Date: Tue Sep 23 18:06:19 2014 -0700 perldelta: reword prev. commitâs entry for clarity M pod/perldelta.pod commit 7776003ecba252f04a5359ee75d84770ad318f9a Author: Daniel Dragan <[email protected]> Date: Tue Sep 23 18:19:32 2014 -0400 optimize pp_length for simple PVs Previously in pp_length, for non-magic, non-utf8 PVs, a number of conditional branches based on bitfield testing had to execute, and finally the length of a non-utf8 SVPV was fetched with sv_len_utf8_nomg. sv_len_utf8_nomg checks SvUTF8, and if false, use the len from SvPV_nomg_const call in sv_len_utf8_nomg. Note in pp_length, SvPV_nomg_const already exists for the "use bytes" branch. After this patch, a !SvGMAGICAL && (!SvUTF8 || use_bytes) SV will take only 1 conditional branch and no func calls before reaching sv_setiv. svflags is reused for the mg_get test since partially masked svflags will already be in a register vs fetching the whole flags from SV head again. SETS(TARG) was factored out from all the SETI/SETTARG macros. If targ is not set/written to (the PL_sv_undef branch), do not check/call for set magic on it, just return from the opcode. Also a putback was removed since the operand SV is replaced inplace on Perl stack with a SV with IV length in it. For profiling info, profiling stats, and rejected implementations see [perl #122835] M pod/perldelta.pod M pp.c ----------------------------------------------------------------------- Summary of changes: pod/perldelta.pod | 3 ++- pp.c | 39 ++++++++++++++++++++++++++++++--------- 2 files changed, 32 insertions(+), 10 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 608c1df..74a365b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -104,7 +104,8 @@ There may well be none in a stable release. =item * -XXX +C<length> is up to 20% faster for non-magical/non-tied scalars containing a +string if it is a non-utf8 string or if C<use bytes;> is in scope. =back diff --git a/pp.c b/pp.c index d33914b..18c3f03 100644 --- a/pp.c +++ b/pp.c @@ -2956,24 +2956,45 @@ PP(pp_length) dSP; dTARGET; SV * const sv = TOPs; - SvGETMAGIC(sv); + U32 in_bytes = IN_BYTES; + /* simplest case shortcut */ + /* turn off SVf_UTF8 in tmp flags if HINT_BYTES on*/ + U32 svflags = (SvFLAGS(sv) ^ (in_bytes << 26)) & (SVf_POK|SVs_GMG|SVf_UTF8); + assert(HINT_BYTES == 0x00000008 && SVf_UTF8 == 0x20000000 && (SVf_UTF8 == HINT_BYTES << 26)); + SETs(TARG); + + if(LIKELY(svflags == SVf_POK)) + goto simple_pv; + if(svflags & SVs_GMG) + mg_get(sv); if (SvOK(sv)) { - if (!IN_BYTES) - SETi(sv_len_utf8_nomg(sv)); + if (!IN_BYTES) /* reread to avoid using an C auto/register */ + sv_setiv(TARG, (IV)sv_len_utf8_nomg(sv)); else { STRLEN len; - (void)SvPV_nomg_const(sv,len); - SETi(len); + /* unrolled SvPV_nomg_const(sv,len) */ + if(SvPOK_nog(sv)){ + simple_pv: + len = SvCUR(sv); + } else { + (void)sv_2pv_flags(sv, &len, 0|SV_CONST_RETURN); + } + sv_setiv(TARG, (IV)(len)); } } else { if (!SvPADTMP(TARG)) { sv_setsv_nomg(TARG, &PL_sv_undef); - SETTARG; - } - SETs(&PL_sv_undef); + } else { /* TARG is on stack at this point and is overwriten by SETs. + This branch is the odd one out, so put TARG by default on + stack earlier to let local SP go out of liveness sooner */ + SETs(&PL_sv_undef); + goto no_set_magic; + } } - RETURN; + SvSETMAGIC(TARG); + no_set_magic: + return NORMAL; /* no putback, SP didn't move in this opcode */ } /* Returns false if substring is completely outside original string. -- Perl5 Master Repository
