Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Reduce malloc&free for S_parse_gv_stash_name #15689

Closed
p5pRT opened this issue Oct 31, 2016 · 29 comments
Closed

Reduce malloc&free for S_parse_gv_stash_name #15689

p5pRT opened this issue Oct 31, 2016 · 29 comments

Comments

@p5pRT
Copy link

p5pRT commented Oct 31, 2016

Migrated from rt.perl.org#129990 (status was 'resolved')

Searchable as RT129990$

@p5pRT
Copy link
Author

p5pRT commented Oct 31, 2016

From @atoomic

Created by @atoomic

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 :​:.

Perl Info

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--

@p5pRT
Copy link
Author

p5pRT commented Oct 31, 2016

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Oct 31, 2016

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Oct 31, 2016

From @atoomic

On Mon Oct 31 15​:56​:32 2016, tonyc wrote​:

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

@p5pRT
Copy link
Author

p5pRT commented Oct 31, 2016

From @atoomic

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

@p5pRT
Copy link
Author

p5pRT commented Nov 2, 2016

From @jkeenan

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.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Nov 9, 2016

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Nov 9, 2016

From @atoomic

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

@p5pRT
Copy link
Author

p5pRT commented Nov 13, 2016

From @atoomic

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​:

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

@p5pRT
Copy link
Author

p5pRT commented Nov 13, 2016

From @atoomic

removal.patch
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;
 }

@p5pRT
Copy link
Author

p5pRT commented Nov 13, 2016

From @atoomic

Here is an improved patch that solves the single package issue
Using the same benchmark tests, here are the updated results

./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​:

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

@p5pRT
Copy link
Author

p5pRT commented Nov 13, 2016

From @atoomic

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

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2016

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @atoomic

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​: atoomic@adda0b6

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

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @atoomic

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)

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @cpansprout

On Thu, 27 Apr 2017 10​:09​:36 -0700, atoomic wrote​:

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

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @atoomic

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'}"
},
]

./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​:

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​:
atoomic@adda0b6

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

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @atoomic

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)

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @atoomic

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)

@p5pRT
Copy link
Author

p5pRT commented Apr 27, 2017

From @cpansprout

On Thu, 27 Apr 2017 11​:32​:02 -0700, atoomic wrote​:

Not sure to understand the impact on "instances" (what is one instance
? a branch ?)

By instances I mean occurrences in production code.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Aug 31, 2017

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Sep 1, 2017

From @atoomic

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​:

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

@p5pRT
Copy link
Author

p5pRT commented Sep 1, 2017

From @atoomic

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

@p5pRT
Copy link
Author

p5pRT commented Sep 1, 2017

From @atoomic

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

@p5pRT
Copy link
Author

p5pRT commented Sep 1, 2017

From @atoomic

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

@p5pRT
Copy link
Author

p5pRT commented Sep 5, 2017

From @tonycoz

On Fri, 01 Sep 2017 13​:15​:55 -0700, atoomic wrote​:

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 f8ac814, 8c573be and f3d6edb.

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

@p5pRT
Copy link
Author

p5pRT commented Sep 5, 2017

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release yesterday of Perl 5.28.0, this and 185 other issues have been
resolved.

Perl 5.28.0 may be downloaded via​:
https://metacpan.org/release/XSAWYERX/perl-5.28.0

If you find that the problem persists, feel free to reopen this ticket.

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

@khwilliamson - Status changed from 'pending release' to 'resolved'

@p5pRT p5pRT closed this as completed Jun 23, 2018
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant