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

Minor speedup improvement for pp_require #16175

Closed
p5pRT opened this issue Sep 26, 2017 · 15 comments
Closed

Minor speedup improvement for pp_require #16175

p5pRT opened this issue Sep 26, 2017 · 15 comments

Comments

@p5pRT
Copy link

p5pRT commented Sep 26, 2017

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

Searchable as RT132171$

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @atoomic

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


notice that doing an extra INC check before calling require can improve the
performance if the module is already loaded

The idea of this commit is to check INC earlier if possible, by avoiding
the IS_SAFE_PATHNAME check in S_require_file called by pp_require.

Would add some benchmark in a future message to show the improvements.

echo 'package Foo; 1;' > lib/Foo.pm
time ./perl -Ilib -E 'for (1..100000000) { require Foo unless
$INC{"Foo.pm"} } '

real 0m5.345s
user 0m5.334s
sys 0m0.010s

time ./perl -Ilib -E 'for (1..100000000) { require Foo } '

real 0m5.847s
user 0m5.840s
sys 0m0.008s



Flags​:
  category=core
  severity=low


Site configuration information for perl 5.27.5​:

Configured by root at Tue Sep 26 16​:44​:50 CDT 2017.

Summary of my perl5 (revision 5 version 27 subversion 5) configuration​:
  Derived from​: c5aa55a
  Platform​:
  osname=linux
  osvers=3.10.0-693.2.2.el7.x86_64
  archname=x86_64-linux
  uname='linux nico-c7.dev.cpanel.net 3.10.0-693.2.2.el7.x86_64 #1 smp
tue sep 12 22​:26​:13 utc 2017 x86_64 x86_64 x86_64 gnulinux '
  config_args='-Dusedevel -des'
  hint=recommended
  useposix=true
  d_sigaction=define
  useithreads=undef
  usemultiplicity=undef
  use64bitint=define
  use64bitall=define
  uselongdouble=undef
  usemymalloc=n
  default_inc_excludes_dot=define
  bincompat5005=undef
  Compiler​:
  cc='cc'
  ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong
-I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64
-D_FORTIFY_SOURCE=2'
  optimize='-O2'
  cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong
-I/usr/local/include'
  ccversion=''
  gccversion='4.8.5 20150623 (Red Hat 4.8.5-16)'
  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='cc'
  ldflags =' -fstack-protector-strong -L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib /lib/../lib64 /usr/lib/../lib64 /lib
/lib64 /usr/lib64 /usr/local/lib64
  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=false
  libperl=libperl.a
  gnulibc_version='2.17'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs
  dlext=so
  d_dlsymun=undef
  ccdlflags='-Wl,-E'
  cccdlflags='-fPIC'
  lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches​:
  uncommitted-changes


@​INC for perl 5.27.5​:
  lib
  /root/.dotfiles/perl-must-have/lib
  /root/perl5/lib/perl5/
  /usr/local/lib/perl5/site_perl/5.27.5/x86_64-linux
  /usr/local/lib/perl5/site_perl/5.27.5
  /usr/local/lib/perl5/5.27.5/x86_64-linux
  /usr/local/lib/perl5/5.27.5


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

PATH=/usr/local/cpanel/3rdparty/perl/526/bin​:/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

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @atoomic

0001-pp_require-return-earlier-when-module-is-already-loa.patch
From 27059c3d9938ec4993efee4ec069a9b79b361aac Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Tue, 26 Sep 2017 18:07:47 -0500
Subject: [PATCH] pp_require: return earlier when module is already loaded

---
 pp_ctl.c | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 5f3cfdf23f..3bea5d4246 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3752,6 +3752,7 @@ S_require_file(pTHX_ SV *sv)
     I32 old_savestack_ix;
     const bool op_is_require = PL_op->op_type == OP_REQUIRE;
     const char *const op_name = op_is_require ? "require" : "do";
+    SV ** svp_cached = NULL;
 
     assert(op_is_require || PL_op->op_type == OP_DOFILE);
 
@@ -3761,6 +3762,15 @@ S_require_file(pTHX_ SV *sv)
     if (!(name && len > 0 && *name))
         DIE(aTHX_ "Missing or undefined argument to %s", op_name);
 
+#ifndef VMS
+	/* try to return earlier (save the SAFE_PATHNAME check) if INC already got the name */
+	if (op_is_require) {
+		/* can optimize to only perform one single lookup */
+		SV ** svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0);
+		if ( svp_cached && *svp_cached != &PL_sv_undef ) RETPUSHYES;
+	}
+#endif
+
     if (!IS_SAFE_PATHNAME(name, len, op_name)) {
         if (!op_is_require) {
             CLEAR_ERRSV();
@@ -3799,8 +3809,8 @@ S_require_file(pTHX_ SV *sv)
 	unixlen = len;
     }
     if (op_is_require) {
-	SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
-					  unixname, unixlen, 0);
+	/* reuse the previous hv_fetch result if possible */
+	SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
 	if ( svp ) {
 	    if (*svp != &PL_sv_undef)
 		RETPUSHYES;
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @atoomic

Just ran some basic benchmark with/without the patch on top of blead=dc41635313 using Porting/bench.pl tool and the following command​:

./perl -Ilib Porting/bench.pl --benchfile=../benchmark-tests ../perl2/perl=blead ./perl=blead+patch

Of course, the result highly depends on the test used, I try to provide some basic scenarii with short and long module names existing or not.

Feel free to comment on it

On Tue, 26 Sep 2017 16​:16​:26 -0700, 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.27.5.

-----------------------------------------------------------------

notice that doing an extra INC check before calling require can
improve the
performance if the module is already loaded

The idea of this commit is to check INC earlier if possible, by
avoiding
the IS_SAFE_PATHNAME check in S_require_file called by pp_require.

Would add some benchmark in a future message to show the improvements.

echo 'package Foo; 1;' > lib/Foo.pm
time ./perl -Ilib -E 'for (1..100000000) { require Foo unless
$INC{"Foo.pm"} } '

real 0m5.345s
user 0m5.334s
sys 0m0.010s

time ./perl -Ilib -E 'for (1..100000000) { require Foo } '

real 0m5.847s
user 0m5.840s
sys 0m0.008s

-----------------------------------------------------------------
---
Flags​:
category=core
severity=low
---
Site configuration information for perl 5.27.5​:

Configured by root at Tue Sep 26 16​:44​:50 CDT 2017.

Summary of my perl5 (revision 5 version 27 subversion 5)
configuration​:
Derived from​: c5aa55a
Platform​:
osname=linux
osvers=3.10.0-693.2.2.el7.x86_64
archname=x86_64-linux
uname='linux nico-c7.dev.cpanel.net 3.10.0-693.2.2.el7.x86_64 #1
smp
tue sep 12 22​:26​:13 utc 2017 x86_64 x86_64 x86_64 gnulinux '
config_args='-Dusedevel -des'
hint=recommended
useposix=true
d_sigaction=define
useithreads=undef
usemultiplicity=undef
use64bitint=define
use64bitall=define
uselongdouble=undef
usemymalloc=n
default_inc_excludes_dot=define
bincompat5005=undef
Compiler​:
cc='cc'
ccflags ='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-
strong
-I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64
-D_FORTIFY_SOURCE=2'
optimize='-O2'
cppflags='-fwrapv -fno-strict-aliasing -pipe -fstack-protector-
strong
-I/usr/local/include'
ccversion=''
gccversion='4.8.5 20150623 (Red Hat 4.8.5-16)'
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='cc'
ldflags =' -fstack-protector-strong -L/usr/local/lib'
libpth=/usr/local/lib /usr/lib /lib/../lib64 /usr/lib/../lib64
/lib
/lib64 /usr/lib64 /usr/local/lib64
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=false
libperl=libperl.a
gnulibc_version='2.17'
Dynamic Linking​:
dlsrc=dl_dlopen.xs
dlext=so
d_dlsymun=undef
ccdlflags='-Wl,-E'
cccdlflags='-fPIC'
lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches​:
uncommitted-changes

---
@​INC for perl 5.27.5​:
lib
/root/.dotfiles/perl-must-have/lib
/root/perl5/lib/perl5/
/usr/local/lib/perl5/site_perl/5.27.5/x86_64-linux
/usr/local/lib/perl5/site_perl/5.27.5
/usr/local/lib/perl5/5.27.5/x86_64-linux
/usr/local/lib/perl5/5.27.5

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

PATH=/usr/local/cpanel/3rdparty/perl/526/bin​:/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

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @atoomic

0001-pp_require-return-earlier-when-module-is-already-loa.patch
From 27059c3d9938ec4993efee4ec069a9b79b361aac Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Tue, 26 Sep 2017 18:07:47 -0500
Subject: [PATCH] pp_require: return earlier when module is already loaded

---
 pp_ctl.c | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 5f3cfdf23f..3bea5d4246 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3752,6 +3752,7 @@ S_require_file(pTHX_ SV *sv)
     I32 old_savestack_ix;
     const bool op_is_require = PL_op->op_type == OP_REQUIRE;
     const char *const op_name = op_is_require ? "require" : "do";
+    SV ** svp_cached = NULL;
 
     assert(op_is_require || PL_op->op_type == OP_DOFILE);
 
@@ -3761,6 +3762,15 @@ S_require_file(pTHX_ SV *sv)
     if (!(name && len > 0 && *name))
         DIE(aTHX_ "Missing or undefined argument to %s", op_name);
 
+#ifndef VMS
+	/* try to return earlier (save the SAFE_PATHNAME check) if INC already got the name */
+	if (op_is_require) {
+		/* can optimize to only perform one single lookup */
+		SV ** svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0);
+		if ( svp_cached && *svp_cached != &PL_sv_undef ) RETPUSHYES;
+	}
+#endif
+
     if (!IS_SAFE_PATHNAME(name, len, op_name)) {
         if (!op_is_require) {
             CLEAR_ERRSV();
@@ -3799,8 +3809,8 @@ S_require_file(pTHX_ SV *sv)
 	unixlen = len;
     }
     if (op_is_require) {
-	SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
-					  unixname, unixlen, 0);
+	/* reuse the previous hv_fetch result if possible */
+	SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
 	if ( svp ) {
 	    if (*svp != &PL_sv_undef)
 		RETPUSHYES;
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @atoomic

./perl -Ilib Porting/bench.pl --benchfile=../inc-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%.

test_1
require Foo

  blead blead+patch
  ------ -----------
  Ir 100.00 109.81
  Dr 100.00 103.73
  Dw 100.00 110.15
  COND 100.00 112.81
  IND 100.00 112.04

COND_m 100.00 100.10
IND_m 100.00 99.99

Ir_m1 100.00 101.03
Dr_m1 100.00 92.54
Dw_m1 100.00 99.66

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_2
Foo_unless_INC

  blead blead+patch
  ------ -----------
  Ir 100.00 100.00
  Dr 100.00 100.00
  Dw 100.00 100.00
  COND 100.00 100.00
  IND 100.00 100.00

COND_m 100.00 100.28
IND_m 100.00 100.02

Ir_m1 100.00 100.23
Dr_m1 100.00 94.49
Dw_m1 100.00 100.65

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_3
require Some​::Thing​::Longer​::To​::Test

  blead blead+patch
  ------ -----------
  Ir 100.00 110.25
  Dr 100.00 103.89
  Dw 100.00 110.15
  COND 100.00 117.46
  IND 100.00 112.03

COND_m 100.00 434.57
IND_m 100.00 99.98

Ir_m1 100.00 101.16
Dr_m1 100.00 78.85
Dw_m1 100.00 75.39

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_4
require Not_There

  blead blead+patch
  ------ -----------
  Ir 100.00 99.83
  Dr 100.00 99.81
  Dw 100.00 99.75
  COND 100.00 99.83
  IND 100.00 100.00

COND_m 100.00 99.33
IND_m 100.00 100.72

Ir_m1 100.00 100.08
Dr_m1 100.00 87.96
Dw_m1 100.00 75.36

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_5
require Not​::There​::Long​::Name​::To​::Test

  blead blead+patch
  ------ -----------
  Ir 100.00 99.84
  Dr 100.00 99.82
  Dw 100.00 99.76
  COND 100.00 99.84
  IND 100.00 100.00

COND_m 100.00 97.45
IND_m 100.00 100.34

Ir_m1 100.00 99.62
Dr_m1 100.00 95.85
Dw_m1 100.00 81.21

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 103.71
  Dr 100.00 101.41
  Dw 100.00 103.72
  COND 100.00 105.46
  IND 100.00 104.49

COND_m 100.00 117.39
IND_m 100.00 100.21

Ir_m1 100.00 100.42
Dr_m1 100.00 89.49
Dw_m1 100.00 85.01

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

From @atoomic

benchmark-tests

@p5pRT
Copy link
Author

p5pRT commented Sep 26, 2017

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

@p5pRT
Copy link
Author

p5pRT commented Sep 27, 2017

From @tonycoz

On Tue, 26 Sep 2017 16​:21​:01 -0700, atoomic wrote​:

Just ran some basic benchmark with/without the patch on top of
blead=dc41635313 using Porting/bench.pl tool and the following
command​:

./perl -Ilib Porting/bench.pl --benchfile=../benchmark-tests
../perl2/perl=blead ./perl=blead+patch

Of course, the result highly depends on the test used, I try to
provide some basic scenarii with short and long module names existing
or not.

Feel free to comment on it

--- a/pp_ctl.c
+++ b/pp_ctl.c
@​@​ -3752,6 +3752,7 @​@​ S_require_file(pTHX_ SV *sv)
  I32 old_savestack_ix;
  const bool op_is_require = PL_op->op_type == OP_REQUIRE;
  const char *const op_name = op_is_require ? "require" : "do";
+ SV ** svp_cached = NULL;

  assert(op_is_require || PL_op->op_type == OP_DOFILE);

@​@​ -3761,6 +3762,15 @​@​ S_require_file(pTHX_ SV *sv)
  if (!(name && len > 0 && *name))
  DIE(aTHX_ "Missing or undefined argument to %s", op_name);

+#ifndef VMS
+ /* try to return earlier (save the SAFE_PATHNAME check) if INC already got the name */
+ if (op_is_require) {
+ /* can optimize to only perform one single lookup */
+ SV ** svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0);

This declares a new svp_cached, so the initial svp_cached isn't modified.

+ if ( svp_cached && *svp_cached != &PL_sv_undef ) RETPUSHYES;
+ }
+#endif
+

@​@​ -3799,8 +3809,8 @​@​ S_require_file(pTHX_ SV *sv)
  unixlen = len;
  }
  if (op_is_require) {
- SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
- unixname, unixlen, 0);
+ /* reuse the previous hv_fetch result if possible */
+ SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
  if ( svp ) {
  if (*svp != &PL_sv_undef)
  RETPUSHYES;
--

so svp_cached is always NULL here.

Tony

@p5pRT
Copy link
Author

p5pRT commented Sep 27, 2017

From @atoomic

Hi, Tony, indeed you are right, sorry came from a last-minute refactoring, I should have noticed it.

That 'svp_cached' variable is not doing the cache it claims to do...

Here is the updated patch. Just confirm that the test suite passes on my box.

I've also updated the benchmark results, using the same tests from benchmark-tests.

nicolas

On Tue, 26 Sep 2017 18​:18​:35 -0700, tonyc wrote​:

On Tue, 26 Sep 2017 16​:21​:01 -0700, atoomic wrote​:

Just ran some basic benchmark with/without the patch on top of
blead=dc41635313 using Porting/bench.pl tool and the following
command​:

./perl -Ilib Porting/bench.pl --benchfile=../benchmark-tests
../perl2/perl=blead ./perl=blead+patch

Of course, the result highly depends on the test used, I try to
provide some basic scenarii with short and long module names existing
or not.

Feel free to comment on it

--- a/pp_ctl.c
+++ b/pp_ctl.c
@​@​ -3752,6 +3752,7 @​@​ S_require_file(pTHX_ SV *sv)
I32 old_savestack_ix;
const bool op_is_require = PL_op->op_type == OP_REQUIRE;
const char *const op_name = op_is_require ? "require" : "do";
+ SV ** svp_cached = NULL;

assert(op_is_require || PL_op->op_type == OP_DOFILE);

@​@​ -3761,6 +3762,15 @​@​ S_require_file(pTHX_ SV *sv)
if (!(name && len > 0 && *name))
DIE(aTHX_ "Missing or undefined argument to %s", op_name);

+#ifndef VMS
+ /* try to return earlier (save the SAFE_PATHNAME check) if INC
already got the name */
+ if (op_is_require) {
+ /* can optimize to only perform one single lookup */
+ SV ** svp_cached = hv_fetch(GvHVn(PL_incgv), (char*)
name, len, 0);

This declares a new svp_cached, so the initial svp_cached isn't
modified.

+ if ( svp_cached && *svp_cached != &PL_sv_undef )
RETPUSHYES;
+ }
+#endif
+

@​@​ -3799,8 +3809,8 @​@​ S_require_file(pTHX_ SV *sv)
unixlen = len;
}
if (op_is_require) {
- SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
- unixname, unixlen, 0);
+ /* reuse the previous hv_fetch result if possible */
+ SV * const * const svp = svp_cached ? svp_cached :
hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
if ( svp ) {
if (*svp != &PL_sv_undef)
RETPUSHYES;

@p5pRT
Copy link
Author

p5pRT commented Sep 27, 2017

From @atoomic

0001-pp_require-return-earlier-when-module-is-already-loa.patch
From 54eb6e76131a19539daa27abe5af4dd36f7df080 Mon Sep 17 00:00:00 2001
From: Nicolas R <atoomic@cpan.org>
Date: Tue, 26 Sep 2017 18:07:47 -0500
Subject: [PATCH] pp_require: return earlier when module is already loaded

---
 pp_ctl.c | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 5f3cfdf23f..1ef7fb463d 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3752,6 +3752,7 @@ S_require_file(pTHX_ SV *sv)
     I32 old_savestack_ix;
     const bool op_is_require = PL_op->op_type == OP_REQUIRE;
     const char *const op_name = op_is_require ? "require" : "do";
+    SV ** svp_cached = NULL;
 
     assert(op_is_require || PL_op->op_type == OP_DOFILE);
 
@@ -3761,6 +3762,15 @@ S_require_file(pTHX_ SV *sv)
     if (!(name && len > 0 && *name))
         DIE(aTHX_ "Missing or undefined argument to %s", op_name);
 
+#ifndef VMS
+	/* try to return earlier (save the SAFE_PATHNAME check) if INC already got the name */
+	if (op_is_require) {
+		/* can optimize to only perform one single lookup */
+		svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0);
+		if ( svp_cached && *svp_cached != &PL_sv_undef ) RETPUSHYES;
+	}
+#endif
+
     if (!IS_SAFE_PATHNAME(name, len, op_name)) {
         if (!op_is_require) {
             CLEAR_ERRSV();
@@ -3799,8 +3809,8 @@ S_require_file(pTHX_ SV *sv)
 	unixlen = len;
     }
     if (op_is_require) {
-	SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
-					  unixname, unixlen, 0);
+	/* reuse the previous hv_fetch result if possible */
+	SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
 	if ( svp ) {
 	    if (*svp != &PL_sv_undef)
 		RETPUSHYES;
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Sep 27, 2017

From @atoomic

./perl -Ilib Porting/bench.pl --benchfile=../inc-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%.

test_1
require Foo

  blead blead+patch
  ------ -----------
  Ir 100.00 109.56
  Dr 100.00 103.73
  Dw 100.00 110.15
  COND 100.00 112.81
  IND 100.00 112.04

COND_m 100.00 99.26
IND_m 100.00 99.99

Ir_m1 100.00 101.00
Dr_m1 100.00 91.61
Dw_m1 100.00 95.24

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_2
Foo_unless_INC

  blead blead+patch
  ------ -----------
  Ir 100.00 100.00
  Dr 100.00 100.00
  Dw 100.00 100.00
  COND 100.00 100.00
  IND 100.00 100.00

COND_m 100.00 100.16
IND_m 100.00 100.02

Ir_m1 100.00 100.23
Dr_m1 100.00 94.49
Dw_m1 100.00 98.87

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_3
require Some​::Thing​::Longer​::To​::Test

  blead blead+patch
  ------ -----------
  Ir 100.00 110.06
  Dr 100.00 103.89
  Dw 100.00 110.15
  COND 100.00 117.46
  IND 100.00 112.03

COND_m 100.00 431.69
IND_m 100.00 99.98

Ir_m1 100.00 101.16
Dr_m1 100.00 78.33
Dw_m1 100.00 73.82

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_4
require Not_There

  blead blead+patch
  ------ -----------
  Ir 100.00 99.83
  Dr 100.00 99.81
  Dw 100.00 99.75
  COND 100.00 99.82
  IND 100.00 100.00

COND_m 100.00 98.86
IND_m 100.00 100.72

Ir_m1 100.00 100.12
Dr_m1 100.00 87.87
Dw_m1 100.00 75.05

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

test_5
require Not​::There​::Long​::Name​::To​::Test

  blead blead+patch
  ------ -----------
  Ir 100.00 99.84
  Dr 100.00 99.82
  Dw 100.00 99.76
  COND 100.00 99.83
  IND 100.00 100.00

COND_m 100.00 97.75
IND_m 100.00 100.51

Ir_m1 100.00 99.76
Dr_m1 100.00 94.11
Dw_m1 100.00 81.08

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 103.63
  Dr 100.00 101.41
  Dw 100.00 103.72
  COND 100.00 105.46
  IND 100.00 104.49

COND_m 100.00 117.04
IND_m 100.00 100.24

Ir_m1 100.00 100.45
Dr_m1 100.00 88.85
Dw_m1 100.00 83.59

Ir_mm 100.00 100.00
Dr_mm 100.00 100.00
Dw_mm 100.00 100.00

@p5pRT
Copy link
Author

p5pRT commented Oct 4, 2017

From @tonycoz

On Wed, 27 Sep 2017 09​:49​:51 -0700, atoomic wrote​:

Hi, Tony, indeed you are right, sorry came from a last-minute
refactoring, I should have noticed it.

That 'svp_cached' variable is not doing the cache it claims to do...

Here is the updated patch. Just confirm that the test suite passes on
my box.

I've also updated the benchmark results, using the same tests from
benchmark-tests.

Thanks, applied as 0cbfaef.

Tony

@p5pRT
Copy link
Author

p5pRT commented Oct 4, 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'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant