make string-append on win32 100 times faster

When a string grows (e.g. gets appended to), perl calls sv_grow. When
sv_grow decides that the memory currently allocated to the string is
insufficient, it calls saferealloc. Depending on whether or not perl
was compiled with 'usemymalloc' this calls realloc in either perls
internal version or on the operating system. Perl requests from
realloc just the amount of memory required for the current
operation. With 'usemymalloc' this is not a problem because it rounds
up memory allocation to a certain geometric progression anyway. When
the operating system's realloc is called, this may or may not lead to
desaster, depending on how it's implemented. On win32 it does lead to
desaster: when I loop 1000 times and each time append 1000 chars to an
initial string size of 10 million, the memory grows from 10.000e6 to
10.001e6 to 10.002e6 and so on 1000 times till it ends at 11.000e6.

diff --git a/perl.h b/perl.h
index 59df0aa..74fb62e 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -979,6 +979,14 @@ EXTERN_C int usleep(unsigned int);
 #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size
 #endif
 
+/* sv_grow() will expand strings by at least a certain percentage of
+   the previously *used* length to avoid excessive calls to realloc().
+   The default is 25% of the current length.
+*/
+#ifndef PERL_STRLEN_EXPAND_SHIFT
+#  define PERL_STRLEN_EXPAND_SHIFT 2
+#endif
+
 #if defined(STANDARD_C) && defined(I_STDDEF)
 #   include <stddef.h>
 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)

diff --git a/sv.c b/sv.c
index a2f9867..1f66e5b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1536,6 +1536,10 @@ Perl_sv_grow(pTHX_ register SV *const sv, register STRLEN newlen)
        s = SvPVX_mutable(sv);
 
     if (newlen > SvLEN(sv)) {          /* need more room? */
+       STRLEN minlen = SvCUR(sv);
+       minlen += (minlen >> PERL_STRLEN_EXPAND_SHIFT) + 10;
+       if (newlen < minlen)
+           newlen = minlen;
 #ifndef Perl_safesysmalloc_size
        newlen = PERL_STRLEN_ROUNDUP(newlen);
 #endif