Skip Menu |
Report information

From: "Nicolas R." <atoomic [...] cpan.org>
To: perlbug [...] perl.org
Subject: Reduce malloc&free for S_parse_gv_stash_name
Date: Mon, 31 Oct 2016 16:06:58 -0600
Download (untitled) / with headers
text/plain 10.3k
Download (untitled) / with headers
text/html 13.1k
This is a bug report for perl from atoomic@cpan.org,
generated with the help of perlbug 1.40 running under perl 5.24.1.


-----------------------------------------------------------------
[Please describe your issue here]

This is a minor improvement by reducing the number of malloc&free
when using ' as package separator. Which also reduces the number of 
check when using ::.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=low
    Type=Patch
    PatchStatus=HasPatch
---
Site configuration information for perl 5.24.1:

Configured by cPanel at Tue Oct 25 12:10:06 MDT 2016.

Summary of my perl5 (revision 5 version 24 subversion 1) configuration:
   
  Platform:
    osname=linux, osvers=3.10.0-327.28.3.el7.x86_64, archname=x86_64-linux-64int
    uname='linux nico-c7.dev.cpanel.net 3.10.0-327.28.3.el7.x86_64 #1 smp thu aug 18 19:05:49 utc 2016 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Dusedevel -Darchname=x86_64-linux-64int -Dcc=/usr/bin/gcc -Dcpp=/usr/bin/cpp -Dusemymalloc=n -DDEBUGGING -Doptimize=-g3 -Accflags=-m64 -Dccflags=-DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/524/include -L/usr/local/cpanel/3rdparty/perl/524/lib64 -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -Duseshrplib -Duselargefiles=yes -Duseposix=true -Dhint=recommended -Duseperlio=yes -Dcppflags=-I/usr/local/cpanel/3rdparty/perl/524/include -L/usr/local/cpanel/3rdparty/perl/524/lib64 -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -Dldflags=-Wl,-rpath -Wl,/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/lib64 -Dprefix=/usr/local/cpanel/3rdparty/perl/524 -Dsiteprefix=/opt/cpanel/perl5/524 -Dsitebin=/opt/cpanel/perl5/524/bin -Dsitelib=/opt/cpanel/perl5/524/site_lib -Dusevendorprefix=true -Dvendorbin=/usr/local/cpanel/3rdparty/perl/524/bin -Dvendorprefix=/usr/local/cpanel/3rdparty/perl/524/lib64/perl5 -Dvendorlib=/usr/local/cpanel/3rdparty/perl/524/lib64/perl5/cpanel_lib -Dprivlib=/usr/local/cpanel/3rdparty/perl/524/lib64/perl5/5.24.1 -Dman1dir=none -Dman3dir=none -Dscriptdir=/usr/local/cpanel/3rdparty/perl/524/bin -Dscriptdirexp=/usr/local/cpanel/3rdparty/perl/524/bin -Dsiteman1dir=none -Dsiteman3dir=none -Dinstallman1dir=none -Dversiononly=no -Dinstallusrbinperl=no -Dcf_by=cPanel -Dmyhostname=localhost -Dperladmin=root@localhost -Dcf_email=support@cpanel.net -Di_dbm=/usr/local/cpanel/3rdparty/include -Di_gdbm=/usr/local/cpanel/3rdparty/include -Di_ndbm=/usr/local/cpanel/3rdparty/include -DDB_File=true -Ud_dosuid -Uuserelocatableinc -Umad -Uusethreads -Uusemultiplicity -Uusesocks -Uuselongdouble -Aldflags=-L/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -lgdbm -Dlocincpth=/usr/local/cpanel/3rdparty/perl/524/include /usr/local/cpanel/3rdparty/include /usr/local/include  -Duse64bitint -Uuse64bitall -Dlibpth=/usr/local/cpanel/3rdparty/perl/524/lib64 /usr/local/cpanel/3rdparty/lib64 /usr/local/lib64 /usr/local/lib /lib64 /usr/lib64 '
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='/usr/bin/gcc', ccflags ='-DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/524/include -L/usr/local/cpanel/3rdparty/perl/524/lib64 -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -m64 -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/cpanel/3rdparty/include -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-g3',
    cppflags='-I/usr/local/cpanel/3rdparty/perl/524/include -L/usr/local/cpanel/3rdparty/perl/524/lib64 -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/524/include -L/usr/local/cpanel/3rdparty/perl/524/lib64 -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -m64 -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/cpanel/3rdparty/include -I/usr/local/include'
    ccversion='', gccversion='4.8.5 20150623 (Red Hat 4.8.5-4)', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='/usr/bin/gcc', ldflags ='-Wl,-rpath -Wl,/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/lib64 -L/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -lgdbm -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/cpanel/3rdparty/perl/524/lib64 /usr/local/cpanel/3rdparty/lib64 /usr/local/lib64 /usr/local/lib /lib64 /usr/lib64 /usr/local/cpanel/3rdparty/lib /usr/local/lib /usr/lib /lib/../lib64 /usr/lib/../lib64 /lib
    libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.17.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.17'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/local/cpanel/3rdparty/perl/524/lib64/perl5/5.24.1/x86_64-linux-64int/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -g3 -L/usr/local/cpanel/3rdparty/perl/524/lib64 -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    RC3
    cPanel patches
    cPanel INC path changes
    Remove . from @INC

---
@INC for perl 5.24.1:
    /root/.dotfiles/perl-must-have/lib
    /root/perl5/lib/perl5/
    /usr/local/cpanel
    /usr/local/cpanel/3rdparty/perl/524/lib64/perl5/cpanel_lib/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/524/lib64/perl5/cpanel_lib
    /usr/local/cpanel/3rdparty/perl/524/lib64/perl5/5.24.1/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/524/lib64/perl5/5.24.1
    /opt/cpanel/perl5/524/site_lib/x86_64-linux-64int
    /opt/cpanel/perl5/524/site_lib

---
Environment for perl 5.24.1:
    HOME=/root
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/cpanel/3rdparty/perl/524/bin:/usr/local/cpanel/3rdparty/perl/522/bin:/usr/local/cpanel/3rdparty/perl/514/bin:/usr/local/cpanel/3rdparty/bin:/root/bin/:/opt/local/bin:/opt/local/sbin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/opt/cpanel/composer/bin:/root/.dotfiles/bin:/root/perl5/bin:/root/.rvm/bin:/root/bin
    PERL5DB=use Devel::NYTProf
    PERL5LIB=/root/.dotfiles/perl-must-have/lib::/root/perl5/lib/perl5/
    PERL_BADLANG (unset)
    PERL_CPANM_OPT=--quiet
    SHELL=/bin/bash

--------------1.40.perlbug
Content-Type: text/x-patch; name="0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patch"
Content-Transfer-Encoding: 8bit
Content-Disposition: attachment; filename="0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patch"

From 113dcb98aa6605d144b6fdb0ff34fcecc63ddc72 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Mon, 31 Oct 2016 09:55:05 -0600
Subject: [PATCH] Reduce malloc&free for S_parse_gv_stash_name

S_parse_gv_stash_name was using multiple malloc
and free when using ' as package separator.
We can malloc & free only once the tmpbuffer as we know the size max.
This is also sligthly improving iterations when using ::
as we do not need to check if we need to free the tmp buffer.

This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check.

diff --git a/gv.c b/gv.c
index 1cf0d8d..ee48749 100644
--- a/gv.c
+++ b/gv.c
@@ -1587,6 +1587,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                STRLEN *len, const char *nambeg, STRLEN full_len,
                const U32 is_utf8, const I32 add)
 {
+    char *tmpbuf = NULL;
     const char *name_cursor;
     const char *const name_end = nambeg + full_len;
     const char *const name_em1 = name_end - 1;
@@ -1616,9 +1617,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                     key = *name;
                     *len += 2;
                 }
-                else {
-                    char *tmpbuf;
-                    Newx(tmpbuf, *len+2, char);
+                else { /* using ' for package separator */
+                    if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */
+                        Newx(tmpbuf, full_len+2, char);
                     Copy(*name, tmpbuf, *len, char);
                     tmpbuf[(*len)++] = ':';
                     tmpbuf[(*len)++] = ':';
@@ -1626,16 +1627,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                 }
                 gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
                 *gv = gvp ? *gvp : NULL;
-                if (*gv && *gv != (const GV *)&PL_sv_undef) {
-                    if (SvTYPE(*gv) != SVt_PVGV)
-                        gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
-                    else
-                        GvMULTI_on(*gv);
-                }
-                if (key != *name)
-                    Safefree(key);
-                if (!*gv || *gv == (const GV *)&PL_sv_undef)
+                if (!*gv || *gv == (const GV *)&PL_sv_undef) {
+                    Safefree(tmpbuf);
                     return FALSE;
+                }
+                /* here we know that *gv && *gv != &PL_sv_undef */
+                if (SvTYPE(*gv) != SVt_PVGV)
+                    gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8);
+                else
+                    GvMULTI_on(*gv);
 
                 if (!(*stash = GvHV(*gv))) {
                     *stash = GvHV(*gv) = newHV();
@@ -1663,11 +1663,13 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
             if (*name == name_end) {
                 if (!*gv)
                     *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+                Safefree(tmpbuf);
                 return TRUE;
             }
         }
     }
     *len = name_cursor - *name;
+    Safefree(tmpbuf);
     return TRUE;
 }
 
-- 
2.10.1


--------------1.40.perlbug--

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 256b
On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote: Show quoted text
> This is a minor improvement by reducing the number of malloc&free > when using ' as package separator. Which also reduces the number of > check when using ::.
Could you attach the patch please? Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 349b
On Mon Oct 31 15:56:32 2016, tonyc wrote: Show quoted text
> On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote: >
> > This is a minor improvement by reducing the number of malloc&free > > when using ' as package separator. Which also reduces the number of > > check when using ::.
> > Could you attach the patch please? > > Tony
Sorry here is the attached file
Subject: 0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patch
From 113dcb98aa6605d144b6fdb0ff34fcecc63ddc72 Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Mon, 31 Oct 2016 09:55:05 -0600 Subject: [PATCH 1/1] Reduce malloc&free for S_parse_gv_stash_name S_parse_gv_stash_name was using multiple malloc and free when using ' as package separator. We can malloc & free only once the tmpbuffer as we know the size max. This is also sligthly improving iterations when using :: as we do not need to check if we need to free the tmp buffer. This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check. --- gv.c | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/gv.c b/gv.c index 1cf0d8d..ee48749 100644 --- a/gv.c +++ b/gv.c @@ -1587,6 +1587,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add) { + char *tmpbuf = NULL; const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; @@ -1616,9 +1617,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, key = *name; *len += 2; } - else { - char *tmpbuf; - Newx(tmpbuf, *len+2, char); + else { /* using ' for package separator */ + if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */ + Newx(tmpbuf, full_len+2, char); Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1626,16 +1627,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, } gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; - if (*gv && *gv != (const GV *)&PL_sv_undef) { - if (SvTYPE(*gv) != SVt_PVGV) - gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); - else - GvMULTI_on(*gv); - } - if (key != *name) - Safefree(key); - if (!*gv || *gv == (const GV *)&PL_sv_undef) + if (!*gv || *gv == (const GV *)&PL_sv_undef) { + Safefree(tmpbuf); return FALSE; + } + /* here we know that *gv && *gv != &PL_sv_undef */ + if (SvTYPE(*gv) != SVt_PVGV) + gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); + else + GvMULTI_on(*gv); if (!(*stash = GvHV(*gv))) { *stash = GvHV(*gv) = newHV(); @@ -1663,11 +1663,13 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, if (*name == name_end) { if (!*gv) *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE)); + Safefree(tmpbuf); return TRUE; } } } *len = name_cursor - *name; + Safefree(tmpbuf); return TRUE; } -- 2.10.1
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 643b
On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote: Show quoted text
> This is a bug report for perl from atoomic@cpan.org, > generated with the help of perlbug 1.40 running under perl 5.24.1. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > This is a minor improvement by reducing the number of malloc&free > when using ' as package separator. Which also reduces the number of > check when using ::. >
How would we measure the improvement? (I'm not a perlguts expert so I can't simply see the improvement by reading the patch.) Thank you very much. -- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 3.8k
On Wed, 02 Nov 2016 05:30:36 -0700, jkeenan wrote: Show quoted text
> On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote:
> > This is a bug report for perl from atoomic@cpan.org, > > generated with the help of perlbug 1.40 running under perl 5.24.1. > > > > > > ----------------------------------------------------------------- > > [Please describe your issue here] > > > > This is a minor improvement by reducing the number of malloc&free > > when using ' as package separator. Which also reduces the number of > > check when using ::. > >
> > How would we measure the improvement? (I'm not a perlguts expert so I > can't simply see the improvement by reading the patch.) > > Thank you very much.
The patch reduces memory allocates when parsing package names where the components are separated by ' instead of "". To measure the difference, build perl without the patch (in separate directories, then create a benchfile for bench.pl, I used the following: [ 'package::simple' => { desc => "simple one-word package name", setup => 'sub foo {}', code => "&{'foo'}" }, 'package::quote' => { desc => "multi-part package name using single quotes", setup => "sub xx'yy'zz'aa'bb'cc'foo {}", code => qq(&{"xx'yy'zz'aa'bb'cc'foo"}) }, 'package::colon' => { desc => "multi-part package name using colons", setup => "sub xx::yy::zz::aa::bb::cc::foo {}", code => "&{'xx::yy::zz::aa::bb::cc::foo'}" }, ] Then run it with bench.pl: $ ./perl -Ilib Porting/bench.pl --benchfile=../129990-bench ../perl2/perl=blead ./perl=blead+patch Key: Ir Instruction read Dr Data read Dw Data write COND conditional branches IND indirect branches _m branch predict miss _m1 level 1 cache miss _mm last cache (e.g. L3) miss - indeterminate percentage (e.g. 1/0) The numbers represent relative counts per loop iteration, compared to blead at 100.0%. Higher is better: for example, using half as many instructions gives 200%, while using twice as many gives 50%. package::simple simple one-word package name blead blead+patch ------ ----------- Ir 100.00 98.59 Dr 100.00 99.08 Dw 100.00 95.24 COND 100.00 98.99 IND 100.00 100.00 COND_m 100.00 112.50 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::quote multi-part package name using single quotes blead blead+patch ------ ----------- Ir 100.00 130.97 Dr 100.00 131.54 Dw 100.00 130.72 COND 100.00 137.60 IND 100.00 135.71 COND_m 100.00 203.70 IND_m 100.00 87.50 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::colon multi-part package name using colons blead blead+patch ------ ----------- Ir 100.00 101.96 Dr 100.00 101.34 Dw 100.00 100.40 COND 100.00 102.56 IND 100.00 100.00 COND_m 100.00 102.04 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 AVERAGE blead blead+patch ------ ----------- Ir 100.00 108.75 Dr 100.00 108.84 Dw 100.00 106.72 COND 100.00 110.62 IND 100.00 109.62 COND_m 100.00 127.13 IND_m 100.00 95.45 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 So the patch slightly slows down single component parsing ("Foo"), significantly speeds up parsing multiple component names using quotes ("Foo'Bar'Quux") and slightly speeds up multiple component names using colons ("Foo::Bar::Quux"). Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 4.3k
Thanks Tony for providing these metrics before I could, I was thinking about using an ltrace to check mallocs&free with long packages using single quote or double colon as separator. The longer the package name is the better should be the improvements On Tue, 08 Nov 2016 16:14:12 -0800, tonyc wrote: Show quoted text
> On Wed, 02 Nov 2016 05:30:36 -0700, jkeenan wrote:
> > On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote:
> > > This is a bug report for perl from atoomic@cpan.org, > > > generated with the help of perlbug 1.40 running under perl 5.24.1. > > > > > > > > > ----------------------------------------------------------------- > > > [Please describe your issue here] > > > > > > This is a minor improvement by reducing the number of malloc&free > > > when using ' as package separator. Which also reduces the number of > > > check when using ::. > > >
> > > > How would we measure the improvement? (I'm not a perlguts expert so > > I > > can't simply see the improvement by reading the patch.) > > > > Thank you very much.
> > The patch reduces memory allocates when parsing package names where > the > components are separated by ' instead of "". > > To measure the difference, build perl without the patch (in separate > directories, then create a benchfile for bench.pl, I used the > following: > > [ > 'package::simple' => > { > desc => "simple one-word package name", > setup => 'sub foo {}', > code => "&{'foo'}" > }, > 'package::quote' => > { > desc => "multi-part package name using single quotes", > setup => "sub xx'yy'zz'aa'bb'cc'foo {}", > code => qq(&{"xx'yy'zz'aa'bb'cc'foo"}) > }, > 'package::colon' => > { > desc => "multi-part package name using colons", > setup => "sub xx::yy::zz::aa::bb::cc::foo {}", > code => "&{'xx::yy::zz::aa::bb::cc::foo'}" > }, > ] > > Then run it with bench.pl: > > $ ./perl -Ilib Porting/bench.pl --benchfile=../129990-bench > ../perl2/perl=blead ./perl=blead+patch > Key: > Ir Instruction read > Dr Data read > Dw Data write > COND conditional branches > IND indirect branches > _m branch predict miss > _m1 level 1 cache miss > _mm last cache (e.g. L3) miss > - indeterminate percentage (e.g. 1/0) > > The numbers represent relative counts per loop iteration, compared to > blead at 100.0%. > Higher is better: for example, using half as many instructions gives > 200%, > while using twice as many gives 50%. > > package::simple > simple one-word package name > > blead blead+patch > ------ ----------- > Ir 100.00 98.59 > Dr 100.00 99.08 > Dw 100.00 95.24 > COND 100.00 98.99 > IND 100.00 100.00 > > COND_m 100.00 112.50 > IND_m 100.00 100.00 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > package::quote > multi-part package name using single quotes > > blead blead+patch > ------ ----------- > Ir 100.00 130.97 > Dr 100.00 131.54 > Dw 100.00 130.72 > COND 100.00 137.60 > IND 100.00 135.71 > > COND_m 100.00 203.70 > IND_m 100.00 87.50 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > package::colon > multi-part package name using colons > > blead blead+patch > ------ ----------- > Ir 100.00 101.96 > Dr 100.00 101.34 > Dw 100.00 100.40 > COND 100.00 102.56 > IND 100.00 100.00 > > COND_m 100.00 102.04 > IND_m 100.00 100.00 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > AVERAGE > > blead blead+patch > ------ ----------- > Ir 100.00 108.75 > Dr 100.00 108.84 > Dw 100.00 106.72 > COND 100.00 110.62 > IND 100.00 109.62 > > COND_m 100.00 127.13 > IND_m 100.00 95.45 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > So the patch slightly slows down single component parsing ("Foo"), > significantly speeds up parsing multiple component names using quotes > ("Foo'Bar'Quux") and slightly speeds up multiple component names using > colons ("Foo::Bar::Quux"). > > Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 4.8k
The single package can probably be speed up by avoiding the extra useless Safefree at the end. Going to benchmark this with this change On Tue, 08 Nov 2016 17:07:15 -0800, atoomic wrote: Show quoted text
> Thanks Tony for providing these metrics before I could, > I was thinking about using an ltrace to check mallocs&free with long > packages > using single quote or double colon as separator. > > The longer the package name is the better should be the improvements > > On Tue, 08 Nov 2016 16:14:12 -0800, tonyc wrote:
> > On Wed, 02 Nov 2016 05:30:36 -0700, jkeenan wrote:
> > > On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote:
> > > > This is a bug report for perl from atoomic@cpan.org, > > > > generated with the help of perlbug 1.40 running under perl > > > > 5.24.1. > > > > > > > > > > > > ----------------------------------------------------------------- > > > > [Please describe your issue here] > > > > > > > > This is a minor improvement by reducing the number of malloc&free > > > > when using ' as package separator. Which also reduces the number > > > > of > > > > check when using ::. > > > >
> > > > > > How would we measure the improvement? (I'm not a perlguts expert > > > so > > > I > > > can't simply see the improvement by reading the patch.) > > > > > > Thank you very much.
> > > > The patch reduces memory allocates when parsing package names where > > the > > components are separated by ' instead of "". > > > > To measure the difference, build perl without the patch (in separate > > directories, then create a benchfile for bench.pl, I used the > > following: > > > > [ > > 'package::simple' => > > { > > desc => "simple one-word package name", > > setup => 'sub foo {}', > > code => "&{'foo'}" > > }, > > 'package::quote' => > > { > > desc => "multi-part package name using single quotes", > > setup => "sub xx'yy'zz'aa'bb'cc'foo {}", > > code => qq(&{"xx'yy'zz'aa'bb'cc'foo"}) > > }, > > 'package::colon' => > > { > > desc => "multi-part package name using colons", > > setup => "sub xx::yy::zz::aa::bb::cc::foo {}", > > code => "&{'xx::yy::zz::aa::bb::cc::foo'}" > > }, > > ] > > > > Then run it with bench.pl: > > > > $ ./perl -Ilib Porting/bench.pl --benchfile=../129990-bench > > ../perl2/perl=blead ./perl=blead+patch > > Key: > > Ir Instruction read > > Dr Data read > > Dw Data write > > COND conditional branches > > IND indirect branches > > _m branch predict miss > > _m1 level 1 cache miss > > _mm last cache (e.g. L3) miss > > - indeterminate percentage (e.g. 1/0) > > > > The numbers represent relative counts per loop iteration, compared to > > blead at 100.0%. > > Higher is better: for example, using half as many instructions gives > > 200%, > > while using twice as many gives 50%. > > > > package::simple > > simple one-word package name > > > > blead blead+patch > > ------ ----------- > > Ir 100.00 98.59 > > Dr 100.00 99.08 > > Dw 100.00 95.24 > > COND 100.00 98.99 > > IND 100.00 100.00 > > > > COND_m 100.00 112.50 > > IND_m 100.00 100.00 > > > > Ir_m1 100.00 100.00 > > Dr_m1 100.00 100.00 > > Dw_m1 100.00 100.00 > > > > Ir_mm 100.00 100.00 > > Dr_mm 100.00 100.00 > > Dw_mm 100.00 100.00 > > > > package::quote > > multi-part package name using single quotes > > > > blead blead+patch > > ------ ----------- > > Ir 100.00 130.97 > > Dr 100.00 131.54 > > Dw 100.00 130.72 > > COND 100.00 137.60 > > IND 100.00 135.71 > > > > COND_m 100.00 203.70 > > IND_m 100.00 87.50 > > > > Ir_m1 100.00 100.00 > > Dr_m1 100.00 100.00 > > Dw_m1 100.00 100.00 > > > > Ir_mm 100.00 100.00 > > Dr_mm 100.00 100.00 > > Dw_mm 100.00 100.00 > > > > package::colon > > multi-part package name using colons > > > > blead blead+patch > > ------ ----------- > > Ir 100.00 101.96 > > Dr 100.00 101.34 > > Dw 100.00 100.40 > > COND 100.00 102.56 > > IND 100.00 100.00 > > > > COND_m 100.00 102.04 > > IND_m 100.00 100.00 > > > > Ir_m1 100.00 100.00 > > Dr_m1 100.00 100.00 > > Dw_m1 100.00 100.00 > > > > Ir_mm 100.00 100.00 > > Dr_mm 100.00 100.00 > > Dw_mm 100.00 100.00 > > > > AVERAGE > > > > blead blead+patch > > ------ ----------- > > Ir 100.00 108.75 > > Dr 100.00 108.84 > > Dw 100.00 106.72 > > COND 100.00 110.62 > > IND 100.00 109.62 > > > > COND_m 100.00 127.13 > > IND_m 100.00 95.45 > > > > Ir_m1 100.00 100.00 > > Dr_m1 100.00 100.00 > > Dw_m1 100.00 100.00 > > > > Ir_mm 100.00 100.00 > > Dr_mm 100.00 100.00 > > Dw_mm 100.00 100.00 > > > > So the patch slightly slows down single component parsing ("Foo"), > > significantly speeds up parsing multiple component names using quotes > > ("Foo'Bar'Quux") and slightly speeds up multiple component names > > using > > colons ("Foo::Bar::Quux"). > > > > Tony
Subject: removal.patch
Download removal.patch
text/plain 262b
diff --git a/gv.c b/gv.c index 00aeab2..d92c3d3 100644 --- a/gv.c +++ b/gv.c @@ -1669,7 +1669,6 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, } } *len = name_cursor - *name; - Safefree(tmpbuf); return TRUE; }
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 6.4k
Here is an improved patch that solves the single package issue Using the same benchmark tests, here are the updated results Show quoted text
> ./perl -Ilib Porting/bench.pl --benchfile=/tmp/bench ../perl-blead/perl=blead ../perl5/perl=blead+patch
Key: Ir Instruction read Dr Data read Dw Data write COND conditional branches IND indirect branches _m branch predict miss _m1 level 1 cache miss _mm last cache (e.g. L3) miss - indeterminate percentage (e.g. 1/0) The numbers represent relative counts per loop iteration, compared to blead at 100.0%. Higher is better: for example, using half as many instructions gives 200%, while using twice as many gives 50%. package::simple simple one-word package name blead blead+patch ------ ----------- Ir 100.00 100.14 Dr 100.00 100.45 Dw 100.00 99.02 COND 100.00 100.00 IND 100.00 100.00 COND_m 100.00 - IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::quote multi-part package name using single quotes blead blead+patch ------ ----------- Ir 100.00 131.39 Dr 100.00 132.67 Dw 100.00 122.44 COND 100.00 143.57 IND 100.00 133.33 COND_m 100.00 68.03 IND_m 100.00 87.50 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 - Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::colon multi-part package name using colons blead blead+patch ------ ----------- Ir 100.00 101.10 Dr 100.00 101.91 Dw 100.00 99.60 COND 100.00 104.20 IND 100.00 100.00 COND_m 100.00 122.22 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 AVERAGE blead blead+patch ------ ----------- Ir 100.00 109.14 Dr 100.00 109.87 Dw 100.00 105.98 COND 100.00 112.94 IND 100.00 109.09 COND_m 100.00 87.41 IND_m 100.00 95.45 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 On Tue, 08 Nov 2016 16:14:12 -0800, tonyc wrote: Show quoted text
> On Wed, 02 Nov 2016 05:30:36 -0700, jkeenan wrote:
> > On Mon Oct 31 15:07:30 2016, atoomic@cpan.org wrote:
> > > This is a bug report for perl from atoomic@cpan.org, > > > generated with the help of perlbug 1.40 running under perl 5.24.1. > > > > > > > > > ----------------------------------------------------------------- > > > [Please describe your issue here] > > > > > > This is a minor improvement by reducing the number of malloc&free > > > when using ' as package separator. Which also reduces the number of > > > check when using ::. > > >
> > > > How would we measure the improvement? (I'm not a perlguts expert so > > I > > can't simply see the improvement by reading the patch.) > > > > Thank you very much.
> > The patch reduces memory allocates when parsing package names where > the > components are separated by ' instead of "". > > To measure the difference, build perl without the patch (in separate > directories, then create a benchfile for bench.pl, I used the > following: > > [ > 'package::simple' => > { > desc => "simple one-word package name", > setup => 'sub foo {}', > code => "&{'foo'}" > }, > 'package::quote' => > { > desc => "multi-part package name using single quotes", > setup => "sub xx'yy'zz'aa'bb'cc'foo {}", > code => qq(&{"xx'yy'zz'aa'bb'cc'foo"}) > }, > 'package::colon' => > { > desc => "multi-part package name using colons", > setup => "sub xx::yy::zz::aa::bb::cc::foo {}", > code => "&{'xx::yy::zz::aa::bb::cc::foo'}" > }, > ] > > Then run it with bench.pl: > > $ ./perl -Ilib Porting/bench.pl --benchfile=../129990-bench > ../perl2/perl=blead ./perl=blead+patch > Key: > Ir Instruction read > Dr Data read > Dw Data write > COND conditional branches > IND indirect branches > _m branch predict miss > _m1 level 1 cache miss > _mm last cache (e.g. L3) miss > - indeterminate percentage (e.g. 1/0) > > The numbers represent relative counts per loop iteration, compared to > blead at 100.0%. > Higher is better: for example, using half as many instructions gives > 200%, > while using twice as many gives 50%. > > package::simple > simple one-word package name > > blead blead+patch > ------ ----------- > Ir 100.00 98.59 > Dr 100.00 99.08 > Dw 100.00 95.24 > COND 100.00 98.99 > IND 100.00 100.00 > > COND_m 100.00 112.50 > IND_m 100.00 100.00 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > package::quote > multi-part package name using single quotes > > blead blead+patch > ------ ----------- > Ir 100.00 130.97 > Dr 100.00 131.54 > Dw 100.00 130.72 > COND 100.00 137.60 > IND 100.00 135.71 > > COND_m 100.00 203.70 > IND_m 100.00 87.50 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > package::colon > multi-part package name using colons > > blead blead+patch > ------ ----------- > Ir 100.00 101.96 > Dr 100.00 101.34 > Dw 100.00 100.40 > COND 100.00 102.56 > IND 100.00 100.00 > > COND_m 100.00 102.04 > IND_m 100.00 100.00 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > AVERAGE > > blead blead+patch > ------ ----------- > Ir 100.00 108.75 > Dr 100.00 108.84 > Dw 100.00 106.72 > COND 100.00 110.62 > IND 100.00 109.62 > > COND_m 100.00 127.13 > IND_m 100.00 95.45 > > Ir_m1 100.00 100.00 > Dr_m1 100.00 100.00 > Dw_m1 100.00 100.00 > > Ir_mm 100.00 100.00 > Dr_mm 100.00 100.00 > Dw_mm 100.00 100.00 > > So the patch slightly slows down single component parsing ("Foo"), > significantly speeds up parsing multiple component names using quotes > ("Foo'Bar'Quux") and slightly speeds up multiple component names using > colons ("Foo::Bar::Quux"). > > Tony
Subject: 0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patch
From 886f1d8b20bafcc9dac9f4d47a5c58157e44d770 Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Mon, 31 Oct 2016 09:55:05 -0600 Subject: [PATCH 1/1] Reduce malloc&free for S_parse_gv_stash_name S_parse_gv_stash_name was using multiple malloc and free when using ' as package separator. We can malloc & free only once the tmpbuffer as we know the size max. This is also sligthly improving iterations when using :: as we do not need to check if we need to free the tmp buffer. This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check. --- gv.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/gv.c b/gv.c index 2dfb364..d92c3d3 100644 --- a/gv.c +++ b/gv.c @@ -1587,6 +1587,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add) { + char *tmpbuf = NULL; const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; @@ -1616,9 +1617,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, key = *name; *len += 2; } - else { - char *tmpbuf; - Newx(tmpbuf, *len+2, char); + else { /* using ' for package separator */ + if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */ + Newx(tmpbuf, full_len+2, char); Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1626,16 +1627,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, } gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; - if (*gv && *gv != (const GV *)&PL_sv_undef) { - if (SvTYPE(*gv) != SVt_PVGV) - gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); - else - GvMULTI_on(*gv); - } - if (key != *name) - Safefree(key); - if (!*gv || *gv == (const GV *)&PL_sv_undef) + if (!*gv || *gv == (const GV *)&PL_sv_undef) { + Safefree(tmpbuf); return FALSE; + } + /* here we know that *gv && *gv != &PL_sv_undef */ + if (SvTYPE(*gv) != SVt_PVGV) + gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); + else + GvMULTI_on(*gv); if (!(*stash = GvHV(*gv))) { *stash = GvHV(*gv) = newHV(); @@ -1663,6 +1663,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, if (*name == name_end) { if (!*gv) *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE)); + Safefree(tmpbuf); return TRUE; } } -- 2.10.2
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.9k
On Sun, 13 Nov 2016 02:41:40 -0800, atoomic wrote: Show quoted text
> Here is an improved patch that solves the single package issue > Using the same benchmark tests, here are the updated results
The improved patch leaks the memory allocated in S_parse_gv_stash_name: tony@mars:.../git/perl$ cat ../129990.pl sub xx'yy'foo {} $x = "xx'yy'foo"; &$x; tony@mars:.../git/perl$ PERL_DESTRUCT_LEVEL=2 valgrind --leak-check=full ./perl ../129990.pl ==18383== Memcheck, a memory error detector ==18383== Copyright (C) 2002-2013, and GNU GPL'd, by Julian Seward et al. ==18383== Using Valgrind-3.10.0 and LibVEX; rerun with -h for copyright info ==18383== Command: ./perl ../129990.pl ==18383== ==18383== ==18383== HEAP SUMMARY: ==18383== in use at exit: 11 bytes in 1 blocks ==18383== total heap usage: 783 allocs, 782 frees, 141,865 bytes allocated ==18383== ==18383== 11 bytes in 1 blocks are definitely lost in loss record 1 of 1 ==18383== at 0x4C28C20: malloc (in /usr/lib/valgrind/vgpreload_memcheck-amd64-linux.so) ==18383== by 0x55853B: Perl_safesysmalloc (util.c:153) ==18383== by 0x479100: S_parse_gv_stash_name (gv.c:1620) ==18383== by 0x47ED8F: Perl_gv_fetchpvn_flags (gv.c:2325) ==18383== by 0x461568: Perl_get_cvn_flags (perl.c:2636) ==18383== by 0x5B7DB6: Perl_pp_entersub (pp_hot.c:3978) ==18383== by 0x556D2C: Perl_runops_debug (dump.c:2235) ==18383== by 0x460E71: S_run_body (perl.c:2526) ==18383== by 0x460454: perl_run (perl.c:2449) ==18383== by 0x41EF9D: main (perlmain.c:123) ==18383== ==18383== LEAK SUMMARY: ==18383== definitely lost: 11 bytes in 1 blocks ==18383== indirectly lost: 0 bytes in 0 blocks ==18383== possibly lost: 0 bytes in 0 blocks ==18383== still reachable: 0 bytes in 0 blocks ==18383== suppressed: 0 bytes in 0 blocks ==18383== ==18383== For counts of detected and suppressed errors, rerun with: -v ==18383== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from 0) Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.6k
Indeed removing the last free lead to a leak. We should then consider the previous patch which is a global improvement IMO, we can also consider dropping support for quote as a package separator. I'm also considering using a small buffer to avoid the malloc in most cases (similar trick than the one used by S_gv_stashpvn_internal ), will probably open another ticket for it, but here is the patch: https://github.com/atoomic/perl5/commit/adda0b6b3fadb22090d53d54c4f9d5c77fdf0372 Merging the two ideas might lead to the expected combo. Any thoughts ? On Mon, 14 Nov 2016 21:47:03 -0800, tonyc wrote: Show quoted text
> On Sun, 13 Nov 2016 02:41:40 -0800, atoomic wrote:
> > Here is an improved patch that solves the single package issue > > Using the same benchmark tests, here are the updated results
> > The improved patch leaks the memory allocated in > S_parse_gv_stash_name: > > tony@mars:.../git/perl$ cat ../129990.pl > sub xx'yy'foo {} > > $x = "xx'yy'foo"; > > &$x; > > tony@mars:.../git/perl$ PERL_DESTRUCT_LEVEL=2 valgrind --leak- > check=full ./perl ../129990.pl > ==18383== Memcheck, a memory error detector > ==18383== Copyright (C) 2002-2013, and GNU GPL'd, by Julian Seward et > al. > ==18383== Using Valgrind-3.10.0 and LibVEX; rerun with -h for > copyright info > ==18383== Command: ./perl ../129990.pl > ==18383== > ==18383== > ==18383== HEAP SUMMARY: > ==18383== in use at exit: 11 bytes in 1 blocks > ==18383== total heap usage: 783 allocs, 782 frees, 141,865 bytes > allocated > ==18383== > ==18383== 11 bytes in 1 blocks are definitely lost in loss record 1 of > 1 > ==18383== at 0x4C28C20: malloc (in > /usr/lib/valgrind/vgpreload_memcheck-amd64-linux.so) > ==18383== by 0x55853B: Perl_safesysmalloc (util.c:153) > ==18383== by 0x479100: S_parse_gv_stash_name (gv.c:1620) > ==18383== by 0x47ED8F: Perl_gv_fetchpvn_flags (gv.c:2325) > ==18383== by 0x461568: Perl_get_cvn_flags (perl.c:2636) > ==18383== by 0x5B7DB6: Perl_pp_entersub (pp_hot.c:3978) > ==18383== by 0x556D2C: Perl_runops_debug (dump.c:2235) > ==18383== by 0x460E71: S_run_body (perl.c:2526) > ==18383== by 0x460454: perl_run (perl.c:2449) > ==18383== by 0x41EF9D: main (perlmain.c:123) > ==18383== > ==18383== LEAK SUMMARY: > ==18383== definitely lost: 11 bytes in 1 blocks > ==18383== indirectly lost: 0 bytes in 0 blocks > ==18383== possibly lost: 0 bytes in 0 blocks > ==18383== still reachable: 0 bytes in 0 blocks > ==18383== suppressed: 0 bytes in 0 blocks > ==18383== > ==18383== For counts of detected and suppressed errors, rerun with: -v > ==18383== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from > 0) > > Tony
Subject: 0001-add-a-small-buffer-to-gv_stash_name.patch
From adda0b6b3fadb22090d53d54c4f9d5c77fdf0372 Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Thu, 27 Apr 2017 10:45:38 -0600 Subject: [PATCH] add a small buffer to gv_stash_name --- gv.c | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/gv.c b/gv.c index d32a9c5..8d69e04 100644 --- a/gv.c +++ b/gv.c @@ -1596,6 +1596,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; + char smallbuf[64]; /* small buffer to avoid a malloc when possible */ PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME; @@ -1627,7 +1628,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, } else { char *tmpbuf; - Newx(tmpbuf, *len+2, char); + /* use our pre-allocated buffer when possible to save a malloc */ + if ( *len+2 <= sizeof smallbuf) + tmpbuf = smallbuf; + else + Newx(tmpbuf, *len+2, char); Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1641,7 +1646,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, else GvMULTI_on(*gv); } - if (key != *name) + if (key != *name && key != smallbuf) Safefree(key); if (!*gv || *gv == (const GV *)&PL_sv_undef) return FALSE; -- 2.10.1 (Apple Git-78)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 284b
On Thu, 27 Apr 2017 10:09:36 -0700, atoomic wrote: Show quoted text
> we can also consider dropping support for quote as a package > separator.
Which would require me to change thousands of instances. I would prefer to spend time doing something more productive than that. -- Father Chrysostomos
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 7.1k
Attached are the two patches, and here is a bench using Tony idea + some extra tests. Can also view the patches on github: https://github.com/atoomic/perl5/commits/devel/blead_S_parse_gv_stash_name Fetching a gv is so common that I think, even if it s a win of a few percentage, might worth considering them. Not sure to understand the impact on "instances" (what is one instance ? a branch ?) I've used this test. [ 'package::simple' => { desc => "simple one-word package name", setup => 'sub foo {}', code => "&{'foo'}" }, 'package::quote' => { desc => "multi-part package name using single quotes", setup => "sub xx'yy'zz'aa'bb'cc'foo {}", code => qq(&{"xx'yy'zz'aa'bb'cc'foo"}) }, 'package::colon' => { desc => "multi-part package name using colons", setup => "sub xx::yy::zz::aa::bb::cc::foo {}", code => "&{'xx::yy::zz::aa::bb::cc::foo'}" }, 'IPC::Open3' => { desc => "simple function IPC::Open3::f", setup => "sub IPC::Open3::f {}", code => "&{'IPC::Open3::f'}" }, 'My::Module::Sample::whatever' => { desc => "sub My::Module::Sample::whatever", setup => "sub My::Module::Sample::whatever_function {}", code => "&{'My::Module::Sample::whatever_function'}" }, ] Show quoted text
> ./perl -Ilib Porting/bench.pl --benchfile=../my-129990-bench ../perl2/perl=blead ./perl=blead+patch
Key: Ir Instruction read Dr Data read Dw Data write COND conditional branches IND indirect branches _m branch predict miss _m1 level 1 cache miss _mm last cache (e.g. L3) miss - indeterminate percentage (e.g. 1/0) The numbers represent relative counts per loop iteration, compared to blead at 100.0%. Higher is better: for example, using half as many instructions gives 200%, while using twice as many gives 50%. package::simple simple one-word package name blead blead+patch ------ ----------- Ir 100.00 99.59 Dr 100.00 99.56 Dw 100.00 98.08 COND 100.00 100.00 IND 100.00 100.00 COND_m 100.00 200.00 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::quote multi-part package name using single quotes blead blead+patch ------ ----------- Ir 100.00 142.89 Dr 100.00 141.88 Dw 100.00 140.29 COND 100.00 157.14 IND 100.00 130.77 COND_m 100.00 111.11 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::colon multi-part package name using colons blead blead+patch ------ ----------- Ir 100.00 101.44 Dr 100.00 101.59 Dw 100.00 101.61 COND 100.00 104.48 IND 100.00 100.00 COND_m 100.00 122.22 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 IPC::Open3 simple function IPC::Open3::f blead blead+patch ------ ----------- Ir 100.00 100.78 Dr 100.00 100.79 Dw 100.00 100.00 COND 100.00 102.93 IND 100.00 100.00 COND_m 100.00 114.29 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 My::Module::Sample::whatever sub My::Module::Sample::whatever blead blead+patch ------ ----------- Ir 100.00 100.86 Dr 100.00 101.01 Dw 100.00 100.57 COND 100.00 102.65 IND 100.00 100.00 COND_m 100.00 128.57 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 AVERAGE blead blead+patch ------ ----------- Ir 100.00 106.99 Dr 100.00 106.93 Dw 100.00 106.14 COND 100.00 110.15 IND 100.00 104.94 COND_m 100.00 129.17 IND_m 100.00 100.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 On Thu, 27 Apr 2017 10:09:36 -0700, atoomic wrote: Show quoted text
> Indeed removing the last free lead to a leak. > > We should then consider the previous patch which is a global > improvement IMO, > we can also consider dropping support for quote as a package > separator. > > I'm also considering using a small buffer to avoid the malloc in most > cases (similar trick than the one used by S_gv_stashpvn_internal ), > will probably open another ticket for it, but here is the patch: > https://github.com/atoomic/perl5/commit/adda0b6b3fadb22090d53d54c4f9d5c77fdf0372 > > Merging the two ideas might lead to the expected combo. > > Any thoughts ? > > On Mon, 14 Nov 2016 21:47:03 -0800, tonyc wrote:
> > On Sun, 13 Nov 2016 02:41:40 -0800, atoomic wrote:
> > > Here is an improved patch that solves the single package issue > > > Using the same benchmark tests, here are the updated results
> > > > The improved patch leaks the memory allocated in > > S_parse_gv_stash_name: > > > > tony@mars:.../git/perl$ cat ../129990.pl > > sub xx'yy'foo {} > > > > $x = "xx'yy'foo"; > > > > &$x; > > > > tony@mars:.../git/perl$ PERL_DESTRUCT_LEVEL=2 valgrind --leak- > > check=full ./perl ../129990.pl > > ==18383== Memcheck, a memory error detector > > ==18383== Copyright (C) 2002-2013, and GNU GPL'd, by Julian Seward et > > al. > > ==18383== Using Valgrind-3.10.0 and LibVEX; rerun with -h for > > copyright info > > ==18383== Command: ./perl ../129990.pl > > ==18383== > > ==18383== > > ==18383== HEAP SUMMARY: > > ==18383== in use at exit: 11 bytes in 1 blocks > > ==18383== total heap usage: 783 allocs, 782 frees, 141,865 bytes > > allocated > > ==18383== > > ==18383== 11 bytes in 1 blocks are definitely lost in loss record 1 > > of > > 1 > > ==18383== at 0x4C28C20: malloc (in > > /usr/lib/valgrind/vgpreload_memcheck-amd64-linux.so) > > ==18383== by 0x55853B: Perl_safesysmalloc (util.c:153) > > ==18383== by 0x479100: S_parse_gv_stash_name (gv.c:1620) > > ==18383== by 0x47ED8F: Perl_gv_fetchpvn_flags (gv.c:2325) > > ==18383== by 0x461568: Perl_get_cvn_flags (perl.c:2636) > > ==18383== by 0x5B7DB6: Perl_pp_entersub (pp_hot.c:3978) > > ==18383== by 0x556D2C: Perl_runops_debug (dump.c:2235) > > ==18383== by 0x460E71: S_run_body (perl.c:2526) > > ==18383== by 0x460454: perl_run (perl.c:2449) > > ==18383== by 0x41EF9D: main (perlmain.c:123) > > ==18383== > > ==18383== LEAK SUMMARY: > > ==18383== definitely lost: 11 bytes in 1 blocks > > ==18383== indirectly lost: 0 bytes in 0 blocks > > ==18383== possibly lost: 0 bytes in 0 blocks > > ==18383== still reachable: 0 bytes in 0 blocks > > ==18383== suppressed: 0 bytes in 0 blocks > > ==18383== > > ==18383== For counts of detected and suppressed errors, rerun with: > > -v > > ==18383== ERROR SUMMARY: 1 errors from 1 contexts (suppressed: 0 from > > 0) > > > > Tony
Subject: 0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patch
From 0910ef454ae69d5166ac2f19cc461cfc5d7417cc Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Mon, 31 Oct 2016 09:55:05 -0600 Subject: [PATCH 1/2] Reduce malloc&free for S_parse_gv_stash_name S_parse_gv_stash_name was using multiple malloc and free when using ' as package separator. We can malloc & free only once the tmpbuffer as we know the size max. This is also sligthly improving iterations when using :: as we do not need to check if we need to free the tmp buffer. This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check. --- gv.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/gv.c b/gv.c index d32a9c5..a6aefd0 100644 --- a/gv.c +++ b/gv.c @@ -1593,6 +1593,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add) { + char *tmpbuf = NULL; const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; @@ -1625,9 +1626,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, key = *name; *len += 2; } - else { - char *tmpbuf; - Newx(tmpbuf, *len+2, char); + else { /* using ' for package separator */ + if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */ + Newx(tmpbuf, full_len+2, char); Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1635,16 +1636,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, } gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; - if (*gv && *gv != (const GV *)&PL_sv_undef) { - if (SvTYPE(*gv) != SVt_PVGV) - gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); - else - GvMULTI_on(*gv); - } - if (key != *name) - Safefree(key); - if (!*gv || *gv == (const GV *)&PL_sv_undef) + if (!*gv || *gv == (const GV *)&PL_sv_undef) { + Safefree(tmpbuf); return FALSE; + } + /* here we know that *gv && *gv != &PL_sv_undef */ + if (SvTYPE(*gv) != SVt_PVGV) + gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); + else + GvMULTI_on(*gv); if (!(*stash = GvHV(*gv))) { *stash = GvHV(*gv) = newHV(); @@ -1679,6 +1679,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); } } + Safefree(tmpbuf); return TRUE; } } -- 2.10.1 (Apple Git-78)
Subject: 0002-add-a-small-buffer-to-gv_stash_name.patch
From 5c9104a24efc546c3e991a0e657b19ec24ab017b Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Thu, 27 Apr 2017 11:29:48 -0600 Subject: [PATCH 2/2] add a small buffer to gv_stash_name --- gv.c | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/gv.c b/gv.c index a6aefd0..9dc8771 100644 --- a/gv.c +++ b/gv.c @@ -1593,10 +1593,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add) { - char *tmpbuf = NULL; + char *tmpfullbuf = NULL; /* only malloc one big chunk of memory when the smallbuff is not large enough */ const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; + char smallbuf[64]; /* small buffer to avoid a malloc when possible */ PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME; @@ -1627,8 +1628,16 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, *len += 2; } else { /* using ' for package separator */ - if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */ - Newx(tmpbuf, full_len+2, char); + /* use our pre-allocated buffer when possible to save a malloc */ + char *tmpbuf; + if ( *len+2 <= sizeof smallbuf) + tmpbuf = smallbuf; + else { + /* only malloc once if needed */ + if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */ + Newx(tmpfullbuf, full_len+2, char); + tmpbuf = tmpfullbuf; + } Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1637,7 +1646,8 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; if (!*gv || *gv == (const GV *)&PL_sv_undef) { - Safefree(tmpbuf); + if ( tmpfullbuf != smallbuf ) + Safefree(tmpfullbuf); return FALSE; } /* here we know that *gv && *gv != &PL_sv_undef */ @@ -1679,7 +1689,8 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); } } - Safefree(tmpbuf); + if ( tmpfullbuf != smallbuf ) + Safefree(tmpfullbuf); return TRUE; } } -- 2.10.1 (Apple Git-78)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 219b
On Thu, 27 Apr 2017 11:32:02 -0700, atoomic wrote: Show quoted text
> Not sure to understand the impact on "instances" (what is one instance > ? a branch ?)
By instances I mean occurrences in production code. -- Father Chrysostomos
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.2k
On Thu, 27 Apr 2017 11:32:02 -0700, atoomic wrote: Show quoted text
> Attached are the two patches, and here is a bench using Tony idea + > some extra tests. > Can also view the patches on github: > https://github.com/atoomic/perl5/commits/devel/blead_S_parse_gv_stash_name
Sorry I lost this ticket. There's a couple of issues with the second patch: 1) there's no tests that use the longer allocated buffer. This includes existing tests. From a gcov run: 14: 1635: if ( *len+2 <= sizeof smallbuf) 14: 1636: tmpbuf = smallbuf; -: 1637: else { -: 1638: /* only malloc once if needed */ #####: 1639: if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */ #####: 1640: Newx(tmpfullbuf, full_len+2, char); #####: 1641: tmpbuf = tmpfullbuf; -: 1642: } 14: 1643: Copy(*name, tmpbuf, *len, char); 2) You have this code in a couple of places: if ( tmpfullbuf != smallbuf ) Safefree(tmpfullbuf); but this condition is always true (tmpfullbuf can be NULL or allocated, it's never smallbuf). Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.9k
Thanks Tony for the update, I've addressed your two concerns which were accurate. 1/ add a unit test using long stash names: t/op/stash_parse_gv.t I'm not sure if this should go in t/op, but I put it aside as the op/stash.t one 2/ the 'tmpfullbuf != smallbuf' check is wrong and useless, should simply call Safefree which already perform the check for us when leaving the function You would find attached to this reply the updated patches rebased on a recent blead version. Let me know if this need more work. They are also available on my github account for readability: https://github.com/atoomic/perl5/commits/devel/blead_S_parse_gv_stash_name Thanks nicolas On Wed, 30 Aug 2017 21:10:09 -0700, tonyc wrote: Show quoted text
> On Thu, 27 Apr 2017 11:32:02 -0700, atoomic wrote:
> > Attached are the two patches, and here is a bench using Tony idea + > > some extra tests. > > Can also view the patches on github: > > https://github.com/atoomic/perl5/commits/devel/blead_S_parse_gv_stash_name
> > Sorry I lost this ticket. > > There's a couple of issues with the second patch: > > 1) there's no tests that use the longer allocated buffer. This > includes existing tests. From a gcov run: > > 14: 1635: if ( *len+2 <= sizeof smallbuf) > 14: 1636: tmpbuf = smallbuf; > -: 1637: else { > -: 1638: /* only malloc once if needed */ > #####: 1639: if (tmpfullbuf == NULL) /* only > malloc&free once, a little more than needed */ > #####: 1640: Newx(tmpfullbuf, full_len+2, > char); > #####: 1641: tmpbuf = tmpfullbuf; > -: 1642: } > 14: 1643: Copy(*name, tmpbuf, *len, char); > > 2) You have this code in a couple of places: > > if ( tmpfullbuf != smallbuf ) > Safefree(tmpfullbuf); > > but this condition is always true (tmpfullbuf can be NULL or > allocated, it's never smallbuf). > > Tony
Subject: 0001-Reduce-malloc-free-for-S_parse_gv_stash_name.patch
From b8826c6960dea3a64fbcaed1d10005c76cbc48e9 Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Mon, 31 Oct 2016 09:55:05 -0600 Subject: [PATCH 1/3] Reduce malloc&free for S_parse_gv_stash_name S_parse_gv_stash_name was using multiple malloc and free when using ' as package separator. We can malloc & free only once the tmpbuffer as we know the size max. This is also sligthly improving iterations when using :: as we do not need to check if we need to free the tmp buffer. This is also saving an extra '*gv && *gv != (const GV *)&PL_sv_undef' check. --- gv.c | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/gv.c b/gv.c index afddfe48a8..4bb534b6f1 100644 --- a/gv.c +++ b/gv.c @@ -1595,6 +1595,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add) { + char *tmpbuf = NULL; const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; @@ -1627,9 +1628,9 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, key = *name; *len += 2; } - else { - char *tmpbuf; - Newx(tmpbuf, *len+2, char); + else { /* using ' for package separator */ + if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */ + Newx(tmpbuf, full_len+2, char); Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1637,16 +1638,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, } gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; - if (*gv && *gv != (const GV *)&PL_sv_undef) { - if (SvTYPE(*gv) != SVt_PVGV) - gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); - else - GvMULTI_on(*gv); - } - if (key != *name) - Safefree(key); - if (!*gv || *gv == (const GV *)&PL_sv_undef) + if (!*gv || *gv == (const GV *)&PL_sv_undef) { + Safefree(tmpbuf); return FALSE; + } + /* here we know that *gv && *gv != &PL_sv_undef */ + if (SvTYPE(*gv) != SVt_PVGV) + gv_init_pvn(*gv, *stash, key, *len, (add & GV_ADDMULTI)|is_utf8); + else + GvMULTI_on(*gv); if (!(*stash = GvHV(*gv))) { *stash = GvHV(*gv) = newHV(); @@ -1681,6 +1681,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); } } + Safefree(tmpbuf); return TRUE; } } -- 2.14.1
Subject: 0002-add-a-small-buffer-to-gv_stash_name.patch
From fe56c2b0f1c3268dccba31dcca1bed627d5fd3ae Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Thu, 27 Apr 2017 11:29:48 -0600 Subject: [PATCH 2/3] add a small buffer to gv_stash_name --- gv.c | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/gv.c b/gv.c index 4bb534b6f1..cfe4be572c 100644 --- a/gv.c +++ b/gv.c @@ -1595,10 +1595,11 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add) { - char *tmpbuf = NULL; + char *tmpfullbuf = NULL; /* only malloc one big chunk of memory when the smallbuff is not large enough */ const char *name_cursor; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; + char smallbuf[64]; /* small buffer to avoid a malloc when possible */ PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME; @@ -1629,8 +1630,16 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, *len += 2; } else { /* using ' for package separator */ - if (tmpbuf == NULL) /* only malloc&free once, a little more than needed */ - Newx(tmpbuf, full_len+2, char); + /* use our pre-allocated buffer when possible to save a malloc */ + char *tmpbuf; + if ( *len+2 <= sizeof smallbuf) + tmpbuf = smallbuf; + else { + /* only malloc once if needed */ + if (tmpfullbuf == NULL) /* only malloc&free once, a little more than needed */ + Newx(tmpfullbuf, full_len+2, char); + tmpbuf = tmpfullbuf; + } Copy(*name, tmpbuf, *len, char); tmpbuf[(*len)++] = ':'; tmpbuf[(*len)++] = ':'; @@ -1639,7 +1648,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add); *gv = gvp ? *gvp : NULL; if (!*gv || *gv == (const GV *)&PL_sv_undef) { - Safefree(tmpbuf); + Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */ return FALSE; } /* here we know that *gv && *gv != &PL_sv_undef */ @@ -1681,7 +1690,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); } } - Safefree(tmpbuf); + Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */ return TRUE; } } -- 2.14.1
Subject: 0003-Add-unit-test-t-op-stash_parse_gv.t.patch
From 7ddad600bc5a6acf37d637f158fd462b10633e17 Mon Sep 17 00:00:00 2001 From: Nicolas R <atoomic@cpan.org> Date: Fri, 1 Sep 2017 13:32:43 -0600 Subject: [PATCH 3/3] Add unit test t/op/stash_parse_gv.t This test add coverage for long function names in order to increase test coverage for S_parse_gv_stash_name function. --- MANIFEST | 1 + t/op/stash_parse_gv.t | 31 +++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+) create mode 100644 t/op/stash_parse_gv.t diff --git a/MANIFEST b/MANIFEST index 70b0427153..effc4665ca 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5699,6 +5699,7 @@ t/op/sprintf2.t See if sprintf works t/op/srand.t See if srand works t/op/sselect.t See if 4 argument select works t/op/stash.t See if %:: stashes work +t/op/stash_parse_gv.t See if parse_gv_stash_name works t/op/stat.t See if stat works t/op/state.t See if state variables work t/op/study.t See if study works diff --git a/t/op/stash_parse_gv.t b/t/op/stash_parse_gv.t new file mode 100644 index 0000000000..05694ca8ce --- /dev/null +++ b/t/op/stash_parse_gv.t @@ -0,0 +1,31 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + require "./test.pl"; + set_up_inc(qw(../lib)); +} + +plan( tests => 5 ); + +my $long = 'x' x 100; +my $short = 'abcd'; + +my @tests = ( + [ $long, 'long package name: one word' ], + [ join( '::', $long, $long ), 'long package name: multiple words' ], + [ join( q['], $long, $long ), q[long package name: multiple words using "'" separator] ], + [ join( '::', $long, $short, $long ), 'long & short package name: multiple words' ], + [ join( q['], $long, $short, $long ), q[long & short package name: multiple words using "'" separator] ], +); + +foreach my $t (@tests) { + my ( $sub, $name ) = @$t; + + fresh_perl_is( + qq[sub $sub { print qq[ok\n]} &{"$sub"} ], + q[ok], + { switches => ['-w'] }, + $name + ); +} -- 2.14.1
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.6k
On Fri, 01 Sep 2017 13:15:55 -0700, atoomic wrote: Show quoted text
> Thanks Tony for the update, I've addressed your two concerns which > were accurate. > > 1/ add a unit test using long stash names: t/op/stash_parse_gv.t > I'm not sure if this should go in t/op, but I put it aside as the > op/stash.t one > > 2/ the 'tmpfullbuf != smallbuf' check is wrong and useless, should > simply call Safefree which already perform the check for us when > leaving the function > > You would find attached to this reply the updated patches rebased on a > recent blead version. > Let me know if this need more work.
Thanks, applied as f8ac814f18bfea140da870d907324b308d182202, 8c573bee8897f5c3ea2bb29b6e1a5a7867efa207 and f3d6edb2a15d464a33073e4e7cb8ab5a313ef6cb. For anyone watching at home the bench results have improved over my original tests above: Higher is better: for example, using half as many instructions gives 200%, while using twice as many gives 50%. package::simple simple one-word package name blead blead+patch ------ ----------- Ir 100.00 99.55 Dr 100.00 99.55 Dw 100.00 98.10 COND 100.00 100.00 IND 100.00 100.00 COND_m 100.00 280.00 IND_m 100.00 140.00 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::quote multi-part package name using single quotes blead blead+patch ------ ----------- Ir 100.00 150.00 Dr 100.00 142.19 Dw 100.00 139.73 COND 100.00 150.55 IND 100.00 136.36 COND_m 100.00 288.00 IND_m 100.00 233.33 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 package::colon multi-part package name using colons blead blead+patch ------ ----------- Ir 100.00 102.50 Dr 100.00 101.57 Dw 100.00 101.53 COND 100.00 102.93 IND 100.00 100.00 COND_m 100.00 120.00 IND_m 100.00 233.33 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 AVERAGE blead blead+patch ------ ----------- Ir 100.00 113.34 Dr 100.00 111.43 Dw 100.00 110.29 COND 100.00 113.82 IND 100.00 109.76 COND_m 100.00 195.10 IND_m 100.00 190.91 Ir_m1 100.00 100.00 Dr_m1 100.00 100.00 Dw_m1 100.00 100.00 Ir_mm 100.00 100.00 Dr_mm 100.00 100.00 Dw_mm 100.00 100.00 Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org