develooper Front page | perl.perl5.porters | Postings from November 2016

[perl #129990] Reduce malloc&free for S_parse_gv_stash_name

Thread Previous | Thread Next
From:
Nicolas R .
Date:
November 2, 2016 02:47
Subject:
[perl #129990] Reduce malloc&free for S_parse_gv_stash_name
Message ID:
rt-4.0.24-27651-1477951650-891.129990-75-0@perl.org
# New Ticket Created by  Nicolas R. 
# Please include the string:  [perl #129990]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/Ticket/Display.html?id=129990 >


This is a bug report for perl from atoomic@cpan.org,
generated with the help of perlbug 1.40 running under perl 5.24.1.


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

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

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

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

Summary of my perl5 (revision 5 version 24 subversion 1) configuration:

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

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

---
@INC for perl 5.24.1:
    /root/.dotfiles/perl-must-have/lib
    /root/perl5/lib/perl5/
    /usr/local/cpanel

/usr/local/cpanel/3rdparty/perl/524/lib64/perl5/cpanel_lib/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/524/lib64/perl5/cpanel_lib

/usr/local/cpanel/3rdparty/perl/524/lib64/perl5/5.24.1/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/524/lib64/perl5/5.24.1
    /opt/cpanel/perl5/524/site_lib/x86_64-linux-64int
    /opt/cpanel/perl5/524/site_lib

---
Environment for perl 5.24.1:
    HOME=/root
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)

PATH=/usr/local/cpanel/3rdparty/perl/524/bin:/usr/local/cpanel/3rdparty/perl/522/bin:/usr/local/cpanel/3rdparty/perl/514/bin:/usr/local/cpanel/3rdparty/bin:/root/bin/:/opt/local/bin:/opt/local/sbin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/opt/cpanel/composer/bin:/root/.dotfiles/bin:/root/perl5/bin:/root/.rvm/bin:/root/bin
    PERL5DB=use Devel::NYTProf
    PERL5LIB=/root/.dotfiles/perl-must-have/lib::/root/perl5/lib/perl5/
    PERL_BADLANG (unset)
    PERL_CPANM_OPT=--quiet
    SHELL=/bin/bash

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

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

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

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

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

                 if (!(*stash = GvHV(*gv))) {
                     *stash = GvHV(*gv) = newHV();
@@ -1663,11 +1663,13 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv,
const char **name,
             if (*name == name_end) {
                 if (!*gv)
                     *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::",
TRUE));
+                Safefree(tmpbuf);
                 return TRUE;
             }
         }
     }
     *len = name_cursor - *name;
+    Safefree(tmpbuf);
     return TRUE;
 }

-- 
2.10.1


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


Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About