In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/fe546b38f5a7481954f2f933acf85267578058b3?hp=44563783c331578157881d3a392d50dd3ea07885>
- Log ----------------------------------------------------------------- commit fe546b38f5a7481954f2f933acf85267578058b3 Author: Yves Orton <[email protected]> Date: Sun Oct 30 11:02:57 2016 +0100 fix #129802: sv_grow: remove the overallocation for COW exemption for powers of 2 They are just performance bombs waiting to hit the regex engine and other code. If someone wants this precise level of management then we should provide an API for them to do so. Really this just shows the flaw in our current COW implementation. M sv.c commit 7fdc4f5848180e5ae502e30ea783733d0da04086 Author: Yves Orton <[email protected]> Date: Sun Oct 30 10:56:36 2016 +0100 fix perl #129802 - overallocate in concat to ensure we can COW Otherwise we get degenerate performance in things like the regex engine under certain cases. M sv.c ----------------------------------------------------------------------- Summary of changes: sv.c | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/sv.c b/sv.c index ee6fceb..d3cb3c2 100644 --- a/sv.c +++ b/sv.c @@ -1567,15 +1567,11 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen) * to store the COW count. So in general, allocate one more byte than * asked for, to make it likely this byte is always spare: and thus * make more strings COW-able. - * If the new size is a big power of two, don't bother: we assume the - * caller wanted a nice 2^N sized block and will be annoyed at getting - * 2^N+1. + * * Only increment if the allocation isn't MEM_SIZE_MAX, * otherwise it will wrap to 0. */ - if ( (newlen < 0x1000 || (newlen & (newlen - 1))) - && newlen != MEM_SIZE_MAX - ) + if ( newlen != MEM_SIZE_MAX ) newlen++; #endif @@ -5453,7 +5449,7 @@ Perl_sv_catpvn_flags(pTHX_ SV *const dsv, const char *sstr, const STRLEN slen, c sv_utf8_upgrade_flags_grow(dsv, 0, slen + 1); dlen = SvCUR(dsv); } - else SvGROW(dsv, dlen + slen + 1); + else SvGROW(dsv, dlen + slen + 3); if (sstr == dstr) sstr = SvPVX_const(dsv); Move(sstr, SvPVX(dsv) + dlen, slen, char); @@ -5469,7 +5465,7 @@ Perl_sv_catpvn_flags(pTHX_ SV *const dsv, const char *sstr, const STRLEN slen, c bytes *and* utf8, which would indicate a bug elsewhere. */ assert(sstr != dstr); - SvGROW(dsv, dlen + slen * 2 + 1); + SvGROW(dsv, dlen + slen * 2 + 3); d = (U8 *)SvPVX(dsv) + dlen; while (sstr < send) { -- Perl5 Master Repository
