Reduce malloc&free for S_parse_gv_stash_name

[p5pRT]

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

Searchable as RT129990$

[p5pRT]

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]

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]

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

[p5pRT]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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)