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

[PATCH] modify behavior of SCALAR in *{"_<$filename"} dbg glob for mem saving #14794

Closed
p5pRT opened this issue Jul 7, 2015 · 17 comments
Closed

Comments

@p5pRT
Copy link

p5pRT commented Jul 7, 2015

Migrated from rt.perl.org#125569 (status was 'open')

Searchable as RT125569$

@p5pRT
Copy link
Author

p5pRT commented Jul 7, 2015

From @bulk88

Created by @bulk88

See attached patch.

Memory savings statistics. Win32 Perl on WinXP with VC 2003. First
number in the 400s is starting point (the first system 'pause') memory
usage in KBs. The 2nd number is memory usage in KBs at the second system
'pause'. Memory usage is Private Bytes in Process Explorer, which is all
process unique memory given by the OS to the process. This number
includes all "malloc" memory but not any memory mapped files (most of
perl.exe/most of perl523.dll/etc) backed by disk storage, or
inter-process shared memory areas. The memory counts can only change in
units of 4 KB (x86 page size). I am not sure why different runs produce
slightly different amounts of mem usage (maybe perl hash seed
randomization means different split levels, malloc randomization by the OS).

ExtUtils​::Constant is abandoned on CPAN with no maintainer so core
patching is the only option. An existing note in Maintainers.pl refers
to ExtUtils​::Constant having questionable maintenance.

These patches are low impact patches which dont involve adding new APIs.
I plan to completely rewrite how perl handles storing file paths, which
means new APIs and a higher risk of it being reverted. These are the
last possible optimizations under the old (current) API.

no threads before
perl -e"BEGIN{$^P = $^P | 0x0; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
468
16304
468
16312
468
16312
468
16312
468
16308

no threads before
perl -e"BEGIN{$^P = $^P | 0x2; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
476
22624
476
22628
476
22620
476
22624
476
22620

no threads after
perl -e"BEGIN{$^P = $^P | 0x0; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
468
16280
468
16288
468
16292
468
16292
468
16292

no threads after
perl -e"BEGIN{$^P = $^P | 0x2; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
476
22620
476
22620
476
22616
476
22620
476
22616

threads before
perl -e"BEGIN{$^P = $^P | 0x0; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
492
18968
492
18972
492
18976
492
18976
492
19972

threads before
perl -e"BEGIN{$^P = $^P | 0x2; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
496
26004
496
26004
496
26008
496
25996
496
26004

threads after
perl -e"BEGIN{$^P = $^P | 0x0; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
492
18976
492
18976
492
18968
492
18972
492
18976

threads after
perl -e"BEGIN{$^P = $^P | 0x2; system 'pause';} use Test​::Harness; use
Test​::More; use CPAN; use CPAN​::Meta; use ExtUtils​::MakeMaker; use
Pod​::Perldoc;system 'pause';"
496
25996
496
25988
496
25996
496
25988
496
25992

Perl Info

Flags:
      category=core
      severity=low

Site configuration information for perl 5.23.0:

Configured by Owner at Mon Jun 29 03:16:56 2015.

Summary of my perl5 (revision 5 version 23 subversion 0) configuration:
    Derived from: 63602a3fc27a417daf3c532b6a11ae6eba2a072a
    Platform:
      osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
      uname=''
      config_args='undef'
      hint=recommended, useposix=true, d_sigaction=undef
      useithreads=define, usemultiplicity=define
      use64bitint=undef, use64bitall=undef, uselongdouble=undef
      usemymalloc=n, bincompat5005=undef
    Compiler:
      cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -GL -DWIN32
-D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -D_USE_32BIT_TIME_T',
      optimize='-O1 -MD -Zi -DNDEBUG -GL',
      cppflags='-DWIN32'
      ccversion='13.10.6030', gccversion='', gccosandvers=''
      intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234,
doublekind=3
      d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8,
longdblkind=0
      ivtype='long', ivsize=4, nvtype='double', nvsize=8,
Off_t='__int64', lseeksize=8
      alignbytes=8, prototype=define
    Linker and Libraries:
      ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf
-ltcg 		-libpath:"c:\perl\lib\CORE" 		-machine:x86'
      libpth=\lib
      libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
      perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib
winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib
oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib
version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
      libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl523.lib
      gnulibc_version=''
    Dynamic Linking:
      dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
      cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug
-opt:ref,icf -ltcg 		-libpath:"c:\perl\lib\CORE" 		-machine:x86'

Locally applied patches:
      uncommitted-changes


@INC for perl 5.23.0:
      C:/perl521/srcnewb4opt/lib
      .


Environment for perl 5.23.0:
      HOME (unset)
      LANG (unset)
      LANGUAGE (unset)
      LD_LIBRARY_PATH (unset)
      LOGDIR (unset)
      PATH=C:\sperl\c\bin;C:\WINDOWS\system32;C:\Program Files\Microsoft
Visual Studio .NET 2003\Vc7\bin;C:\Program Files\Microsoft Visual Studio
.NET 2003\Common7\IDE;C:\WINDOWS;C:\Program Files\Git\cmd;C:\Program
Files\Microsoft Visual Studio .NET 2003\Common7\Tools\bin;C:\perl\bin
      PERL_BADLANG (unset)
      PERL_JSON_BACKEND=Cpanel::JSON::XS
      PERL_YAML_BACKEND=YAML
      SHELL (unset)




@p5pRT
Copy link
Author

p5pRT commented Jul 7, 2015

From @bulk88

0001-ExtUtils-Constant-stop-using-SCALAR-of-_-filename-de.patch
From ef023cf594697b1ef5538e87b977b8fb4ff06047 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sat, 4 Jul 2015 09:38:57 -0400
Subject: [PATCH 1/2] ExtUtils::Constant stop using SCALAR of *{"_<$filename"}
 debugging glob

This optimization was added in commit 6736a914b8
"For PROXYSUBS error messages, generate more efficient code for -Uusethreads."

On unthreaded Perl, CopFILE is implemented with debugging path GVs, the
same ones as for storing perl source code. Getting the GvNAME from the
name HEK involves adding the offset from the start of the HEK to the start
of the string part. If you use the SCALAR for the filename, you dont need
to add 8+2 to the pointer, and that saves an cpu instruction. I think that
was NC's point. To allow a future patch that stops creating the
SCALAR part of the debugging glob unless actually using a perl debugger,
CopFILESV can't be used anymore, since in the future it will almost always
be NULL. This patch is related to [perl #125296] and [perl #125512].

Initially undoing NC's change (CopFILESV->CopFILE0 caused
XS_Fcntl_AUTOLOAD's size in machine code on VC2003 -O1 to increase from
0xCB to 0xD1 bytes on unthreaded Win32 perl (the optimization has no effect
with threads). After additional optimizations in AUTOLOAD, the final
size of AUTOLOAD xsub is 0xC0. The cost of reverting the NC optimization
is 6 bytes. Saving just 1 scalar head (no body, no PV) is
16 bytes on 32 bits, so the cost is in the definetly in benefit for
reverting the optimization.

AUTOLOAD
-dont store cop in a C auto around multiple function calls, reduce liveness
-factor out the newSVpvf and 4 args out into 1 block. VC optimizer, which
 isn't the smartest one out there, put 2 identical except for the format
 string branches in machine
-except for arg sv, the other 3 args are calculated in a function call
 free area after hv_exists_ent() executes. Due to C not standardizing the
 order of execution (sequence point) of func args, compute fmt string in
 a separate statement to prevent CopFILE and CopLINE from being stored in
 C autos or non-vols regs while the fmt string is being computed which
 involves func calls

get_missing_hash, previous size 0x76, after size 0x65
-dont deref var ref repeatedly, after each function call the CC must
 reread it
-reorder the call to newHV so the retval of newHV does not need to be
 stored to a non-vol register to be saved around the func call in
 SvUPGRADE, also the retval of newHV will become the retval of
 get_missing_hash without a move cpu instruction
---
 .../lib/ExtUtils/Constant/ProxySubs.pm             |   45 ++++++++++++-------
 1 files changed, 28 insertions(+), 17 deletions(-)

diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm
index 545d322..368a4d1 100644
--- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm
+++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm
@@ -9,7 +9,7 @@ require ExtUtils::Constant::XS;
 use ExtUtils::Constant::Utils qw(C_stringify);
 use ExtUtils::Constant::XS qw(%XS_TypeSet);
 
-$VERSION = '0.08';
+$VERSION = '0.09';
 @ISA = 'ExtUtils::Constant::XS';
 
 %type_to_struct =
@@ -239,13 +239,19 @@ sub WriteConstants {
     if ($autoload || $croak_on_error) {
 	print $c_fh <<'EOC';
 
-/* This allows slightly more efficient code on !USE_ITHREADS: */
+/* This allows slightly more efficient code on !USE_ITHREADS on old perls */
 #ifdef USE_ITHREADS
 #  define COP_FILE(c)	CopFILE(c)
 #  define COP_FILE_F	"s"
 #else
-#  define COP_FILE(c)	CopFILESV(c)
-#  define COP_FILE_F	SVf
+/* CopFILESV is not set in newer perls */
+#  if PERL_REVISION >= 5 && PERL_VERSION >= 23 && PERL_SUBVERSION >= 1
+#    define COP_FILE(c) CopFILE(c)
+#    define COP_FILE_F  "s"
+#  else
+#    define COP_FILE(c) CopFILESV(c)
+#    define COP_FILE_F  SVf
+#  endif
 #endif
 EOC
     }
@@ -350,17 +356,19 @@ get_missing_hash(pTHX) {
     SV *const *const ref
 	= hv_fetch(parent, "$key", $key_len, TRUE);
     HV *new_hv;
+    SV *rv;
 
     if (!ref)
 	return NULL;
 
-    if (SvROK(*ref))
-	return (HV*) SvRV(*ref);
+    rv = *ref;
+    if (SvROK(rv))
+	return (HV*) SvRV(rv);
 
+    SvUPGRADE(rv, SVt_RV);
+    SvROK_on(rv);
     new_hv = newHV();
-    SvUPGRADE(*ref, SVt_RV);
-    SvRV_set(*ref, (SV *)new_hv);
-    SvROK_on(*ref);
+    SvRV_set(rv, (SV *)new_hv);
     return new_hv;
 }
 
@@ -597,6 +605,7 @@ EOBOOT
     return if !defined $xs_subname;
 
     if ($croak_on_error || $autoload) {
+        my $cop = $croak_on_error ? 'cop' : 'PL_curcop';
         print $xs_fh $croak_on_error ? <<"EOC" : <<'EOA';
 
 void
@@ -615,7 +624,6 @@ AUTOLOAD()
     PROTOTYPE: DISABLE
     PREINIT:
 	SV *sv = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SVs_TEMP | SvUTF8(cv));
-	const COP *cop = PL_curcop;
 EOA
         print $xs_fh <<"EOC";
     PPCODE:
@@ -626,17 +634,20 @@ EOA
 	   function too.  */
 	HV *${c_subname}_missing = (C_ARRAY_LENGTH(values_for_notfound) > 1)
 	    ? get_missing_hash(aTHX) : NULL;
-	if ((C_ARRAY_LENGTH(values_for_notfound) > 1)
-	    ? hv_exists_ent(${c_subname}_missing, sv, 0) : 0) {
-	    sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf
-			  ", used at %" COP_FILE_F " line %d\\n", sv,
-			  COP_FILE(cop), CopLINE(cop));
-	} else
-#endif
+	const char * fmt =
+	    ((C_ARRAY_LENGTH(values_for_notfound) > 1)
+		? hv_exists_ent(${c_subname}_missing, sv, 0) : 0)
+	    ? "Your vendor has not defined $package_sprintf_safe macro %"
+		SVf ", used at %" COP_FILE_F " line %d\\n"
+	    : "%"SVf" is not a valid $package_sprintf_safe macro at %"
+		COP_FILE_F " line %d\\n";
+	sv = newSVpvf(fmt, sv, COP_FILE($cop), CopLINE($cop));
+#else
 	{
 	    sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro at %"
 			  COP_FILE_F " line %d\\n", sv, COP_FILE(cop), CopLINE(cop));
 	}
+#endif
 	croak_sv(sv_2mortal(sv));
 EOC
     } else {
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Jul 7, 2015

From @bulk88

0002-modify-behavior-of-SCALAR-in-_-filename-dbg-glob-for.patch
From 1bb089983281485e613a9f2fa8177a6dfec4e056 Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 5 Jul 2015 20:42:25 -0400
Subject: [PATCH 2/2] modify behavior of SCALAR in *{"_<$filename"} dbg glob
 for mem saving

GvFILE's contents is different based on threads and no threads, probably
due to the design of CopFILE in threads and no threads. This difference
affects the ability to optimize things and what is a COW or refcount of
what.

1. Never create the SCALAR part in *{"_<$filename"} debug glob unless
running a perl debugger.

2. When running under perl debugger with threads, use HEK COW from GvFILE
HEK to store filename in SCALAR of *{"_<$filename"} for debugger. Saves
one file path PV (which is a path to a .pm) for each .pm when debugging.

3. GvFILE is very rarely used in core, it is used just once, soley to
provide the "Name "%s::%s" used only once: possible typo" warning.
GvNAME_HEK is a "_<" decorated HEK and was not usable before. Instead
modify GvFILE to be a "_<" decorated HEK instead of a undecorated
HEK on no threads. This allows curcop's GvNAME_HEK to become GvFILE HEKs
with just a ++ on refcount and skipping a hash lookup in newGP, and saves
mem by not creating a new undecorated HEK to store the path.

See mem statistics in future RT ticket for this patch.

See also [perl #125492]. Related to [perl #125296].
---
 ext/B/B.pm        |    2 +-
 ext/B/B.xs        |   22 ++++++++++++++++++++
 gv.c              |   57 +++++++++++++++++++++++++++++++++++++++++++---------
 gv.h              |    9 +++++++-
 pod/perldelta.pod |    2 +-
 5 files changed, 79 insertions(+), 13 deletions(-)

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 0a7727c..706e19a 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -15,7 +15,7 @@ require Exporter;
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.58';
+    $B::VERSION = '1.59';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 016e030..348a60a 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1961,6 +1961,7 @@ BmRARE(sv)
 
 MODULE = B	PACKAGE = B::GV		PREFIX = Gv
 
+#ifdef USE_ITHREADS
 void
 GvNAME(gv)
 	B::GV	gv
@@ -1972,6 +1973,27 @@ GvNAME(gv)
 					: (ix == 1 ? GvFILE_HEK(gv)
 						   : HvNAME_HEK((HV *)gv))));
 
+#else
+
+void
+GvNAME(gv)
+	B::GV	gv
+    ALIAS:
+	B::HV::NAME = 1
+    CODE:
+	ST(0) = sv_2mortal(newSVhek(!ix ? GvNAME_HEK(gv) : HvNAME_HEK((HV *)gv)));
+
+# GvFILE_HEK contains a "_<" prefixed HEK on unthreaded
+
+void
+GvFILE(gv)
+	B::GV	gv
+    CODE:
+	ST(0) = newSVpvn_flags(GvFILEx(gv), GvFILELENx(gv),
+	    SVs_TEMP | SVf_UTF8 * !!HEK_UTF8(GvFILE_HEK(gv)));
+
+#endif
+
 bool
 is_empty(gv)
         B::GV   gv
diff --git a/gv.c b/gv.c
index e4b2aea..c9058a7 100644
--- a/gv.c
+++ b/gv.c
@@ -123,14 +123,47 @@ Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen,
     gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
     if (!isGV(gv)) {
 	gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
+        if ((PERLDB_LINE || PERLDB_SAVESRC)) {
+#ifdef USE_ITHREADS
+            HEK * file_hek = GvFILE_HEK(gv);
+/* On threads, gv_fetchfile is called by core only when perl debugger is on
+   (PERLDB_* flags). When under perl debugger, the majority of the time name
+   happens to be threaded GV's GvFILE HEK. GvFILE is different between threads
+   and unthreaded (see ML
+   "GvFILE and GvLINE origin of globs differ on threaded vs unthreaded perl").
+   The minority exception is "(eval 1234)" strings. The file paths are already
+   availble in HEK form from the GV from newGP so HEK COW the file paths. */
+            if(HEK_LEN(file_hek) == namelen
+                && memEQ(name, HEK_KEY(file_hek), HEK_LEN(file_hek))) {
 #ifdef PERL_DONT_CREATE_GVSV
-	GvSV(gv) = newSVpvn(name, namelen);
+                GvSV(gv) = newSVhek(file_hek);
 #else
-	sv_setpvn(GvSV(gv), name, namelen);
+                sv_sethek(GvSV(gv), file_hek);
 #endif
+            }
+/* Core with threads will only go down this path for "(eval 1234)" as part of
+   perl debugging. Possibly, NYTProf and Embperl will call this func with
+   filenames that arent in PL_curcop, and also take this branch */
+            else
+#endif /* ifdef USE_ITHREADS */
+#ifdef PERL_DONT_CREATE_GVSV
+                GvSV(gv) = newSVpvn(name, namelen);
+#else
+                sv_setpvn(GvSV(gv), name, namelen);
+#endif
+            /* a new GV can't have AV and HV set */
+            goto add_av_and_hv;
+        }
+    }
+    else if ((PERLDB_LINE || PERLDB_SAVESRC) && !GvAV(gv)) {
+        if(!GvHV(gv)) {
+            add_av_and_hv: /* with a new GV these will always be NULL */
+            gv_HVadd(gv);
+        }
+        gv_AVadd(gv);
+        hv_magic(GvHV(gv), GvAV(gv), PERL_MAGIC_dbfile);
     }
-    if ((PERLDB_LINE || PERLDB_SAVESRC) && !GvAV(gv))
-	    hv_magic(GvHVn(gv), GvAVn(gv), PERL_MAGIC_dbfile);
+
     if (tmpbuf != smallbuf)
 	Safefree(tmpbuf);
     return gv;
@@ -191,8 +224,10 @@ Perl_newGP(pTHX_ GV *const gv)
 #else
 	filegv = CopFILEGV(PL_curcop);
 	if (filegv) {
-	    file = GvNAME(filegv)+2;
-	    len = GvNAMELEN(filegv)-2;
+            HEK * hek = GvNAME_HEK(filegv);
+            share_hek_hek(hek);
+            gp->gp_file_hek = hek;
+            goto gp_file_hek_done;
 	}
 #endif
 	else goto no_file;
@@ -202,11 +237,13 @@ Perl_newGP(pTHX_ GV *const gv)
 	file = "";
 	len = 0;
     }
-
     PERL_HASH(hash, file, len);
     gp->gp_file_hek = share_hek(file, len, hash);
-    gp->gp_refcnt = 1;
 
+#ifndef USE_ITHREADS
+    gp_file_hek_done:
+#endif
+    gp->gp_refcnt = 1;
     return gp;
 }
 
@@ -2437,13 +2474,13 @@ Perl_gv_check(pTHX_ HV *stash)
 		gv = MUTABLE_GV(HeVAL(entry));
 		if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
 		    continue;
-		file = GvFILE(gv);
 		CopLINE_set(PL_curcop, GvLINE(gv));
+		file = GvFILEx(gv);
 #ifdef USE_ITHREADS
 		CopFILE(PL_curcop) = (char *)file;	/* set for warning */
 #else
 		CopFILEGV(PL_curcop)
-		    = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
+		    = gv_fetchfile_flags(file, GvFILELENx(gv), 0);
 #endif
 		Perl_warner(aTHX_ packWARN(WARN_ONCE),
 			"Name \"%"HEKf"::%"HEKf
diff --git a/gv.h b/gv.h
index a6bb749..d242d91 100644
--- a/gv.h
+++ b/gv.h
@@ -144,7 +144,14 @@ Return the CV from the GV.
 
 #define GvLINE(gv)	(GvGP(gv)->gp_line)
 #define GvFILE_HEK(gv)	(GvGP(gv)->gp_file_hek)
-#define GvFILEx(gv)	HEK_KEY(GvFILE_HEK(gv))
+/* with threads undecorated path, with no threads HEK is "_<" prefixed (ie decorated), */
+#ifdef USE_ITHREADS
+#  define GvFILEx(gv)	    HEK_KEY(GvFILE_HEK(gv))
+#  define GvFILELENx(gv)    HEK_LEN(GvFILE_HEK(gv))
+#else
+#  define GvFILEx(gv)	    (HEK_KEY(GvFILE_HEK(gv))+2)
+#  define GvFILELENx(gv)    (HEK_LEN(GvFILE_HEK(gv))-2)
+#endif
 #define GvFILE(gv)	(GvFILE_HEK(gv) ? GvFILEx(gv) : NULL)
 #define GvFILEGV(gv)	(GvFILE_HEK(gv) ? gv_fetchfile(GvFILEx(gv)) : NULL)
 
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index ffbd3f1..d2a2f25 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -131,7 +131,7 @@ XXX
 
 =item *
 
-L<XXX> has been upgraded from version A.xx to B.yy.
+L<B> has been upgraded from version 1.58 to 1.59.
 
 =back
 
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Jul 9, 2015

From @rurban

Cannot you put this in a git branch somewhere please?
It affects me a lot, and it's a lot of work to update with patches only.

I like the idea, but I want to check the cornercases.
--
Reini Urban

@p5pRT
Copy link
Author

p5pRT commented Jul 9, 2015

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

@p5pRT
Copy link
Author

p5pRT commented Jul 9, 2015

From @bulk88

On Wed Jul 08 22​:33​:46 2015, rurban wrote​:

Cannot you put this in a git branch somewhere please?
It affects me a lot, and it's a lot of work to update with patches only.

I like the idea, but I want to check the cornercases.

try threaded and unthreaded builds, there is different behavior (or preserving of existing different behavior)

https://github.com/bulk88/perl/tree/pmfiledebugglob
https://github.com/bulk88/perl/tree/removecvfile
https://github.com/bulk88/perl/tree/cvfilelessalloc

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 15, 2015

From @tonycoz

On Tue Jul 07 07​:21​:04 2015, bulk88 wrote​:

Memory savings statistics. Win32 Perl on WinXP with VC 2003. First
number in the 400s is starting point (the first system 'pause') memory
usage in KBs. The 2nd number is memory usage in KBs at the second system
'pause'. Memory usage is Private Bytes in Process Explorer, which is all
process unique memory given by the OS to the process. This number
includes all "malloc" memory but not any memory mapped files (most of
perl.exe/most of perl523.dll/etc) backed by disk storage, or
inter-process shared memory areas. The memory counts can only change in
units of 4 KB (x86 page size). I am not sure why different runs produce
slightly different amounts of mem usage (maybe perl hash seed
randomization means different split levels, malloc randomization by the OS).

ExtUtils​::Constant is abandoned on CPAN with no maintainer so core
patching is the only option. An existing note in Maintainers.pl refers
to ExtUtils​::Constant having questionable maintenance.

These patches are low impact patches which dont involve adding new APIs.
I plan to completely rewrite how perl handles storing file paths, which
means new APIs and a higher risk of it being reverted. These are the
last possible optimizations under the old (current) API.

This breaks Devel​::Profit, which I suspect will need a simple fix.

I expect it to (further) break Enbugger, but that's failing fairly hard on
blead already (and 5.20, 5.22.)

Tony

@p5pRT
Copy link
Author

p5pRT commented Jul 24, 2015

From @bulk88

On Tue Jul 14 23​:50​:31 2015, tonyc wrote​:

This breaks Devel​::Profit, which I suspect will need a simple fix.

There are 3 potential ways to fix Devel​::Profit.

#1
  PL_perldb |= PERLDBf_LINE;

But that probably slows down perl since it turns on debugging facilities, DB callouts, storing extra stuff. If the point of a profiler is to show difference in scale between code parts, it is fine, but PERLDBf_LINE will probably be slowing down the code even more from a unprofiled process. That might be an acceptable tradeoff.

#2 Create
  CopFILESVn(cop)

vivifies the GV and SCALAR of GV if needed, with a private SV * Perl_gv_fetchfilesv(GV* gv) function to vivify SCALAR if SCALAR is NULL. Probably overkill since CopFILESV isn't public API and sparsely used http​://grep.cpan.me/?q=CopFILESV+-file%3Appport.h (note indirect.xs's design, that will probably need to be changed to #if defined(USE_ITHREADS) || PERLVER >= 5.023002 )

#3 Dont use CopFILESV, instead use CopFILE. CopFILE is much more popular than CopFILESV on CPAN http​://grep.cpan.me/?q=CopFILE\W+-file%3Appport.h (one day I am planning that there might be a CopFILEHEK instead of the current malloced char * on ithreads and GV * on unthreaded, so CopFILESV shouldn't be encouraged on CPAN, turning a HEK into a char * is just adding a fixed constant to the HEK *)

I attached patch for Profit.xs that does #1 and #3. Do you TonyC actually use Devel​::Profit regularly or is was it just for testing?

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jul 24, 2015

From @bulk88

0001-no-more-CopFILESV-fix.patch
From d42c40b4b1518ce7a27d3db75d41e0d9ebbd3836 Mon Sep 17 00:00:00 2001
From: bulk88 <bulk88@hotmail.com>
Date: Thu, 23 Jul 2015 22:19:47 -0400
Subject: [PATCH] no more CopFILESV fix

---
 Profit.xs |   49 +++++++++++++++++++++++++++++++++++++++----------
 1 files changed, 39 insertions(+), 10 deletions(-)

diff --git a/Profit.xs b/Profit.xs
index 9a60c0d..8ea8b23 100644
--- a/Profit.xs
+++ b/Profit.xs
@@ -4,8 +4,26 @@
 #include "XSUB.h"
 #include <time.h>
 
+//first way to make this module work
+#if PERL_API_REVISION >= 5 && PERL_API_VERSION >= 23 && PERL_API_SUBVERSION >= 2
+#  define PROFIT_NO_FILE_SV
+#  define profit_exists(hv, key) hv_exists(hv, key, strlen(key))
+#  define profit_fetch(hv, key) *hv_fetch(hv, key, strlen(key), 0)
+#  define profit_store(hv, key, val) hv_store(hv, key, strlen(key), val, 0)
+#  define PROFITFILE2STR(file) file
+#else
+#  define profit_exists(hv, key) hv_exists_ent(hv, key, 0)
+#  define profit_fetch(hv, key) HeVAL(hv_fetch_ent(hv, key, 0, 0))
+#  define profit_store(hv, key, val) hv_store_ent(hv, key, val, 0)
+#  define PROFITFILE2STR(file) SvPV_nolen(file)
+#endif
+
 static FILE *fp;        /* pointer to profile.out file */
+#ifdef PROFIT_NO_FILE_SV
+char *file;
+#else
 SV *file;
+#endif
 int line;
 double start;
 double now;
@@ -13,15 +31,20 @@ double diff;
 HV* seen_file;
 int file_number;
 SV* seen_file_number;
+LARGE_INTEGER        my_freq = {0};
     
 static double get_clock()
 {
-    struct timespec ts;
-    clock_gettime (CLOCK_MONOTONIC, &ts);
+//    struct timespec ts;
+//    clock_gettime (CLOCK_MONOTONIC, &ts);
 //    clock_gettime (CLOCK_REALTIME, &ts);
 //    clock_gettime (CLOCK_PROCESS_CPUTIME_ID, &ts);
 //    clock_gettime (CLOCK_THREAD_CPUTIME_ID, &ts);
-    return 1e9 * ts.tv_sec + ts.tv_nsec;
+//    return 1e9 * ts.tv_sec + ts.tv_nsec;
+    LARGE_INTEGER time;
+    QueryPerformanceCounter(&time);
+    return (double)time.QuadPart/(double)my_freq.QuadPart;
+
 }
 
 int runops_devel_profit(pTHX)
@@ -32,20 +55,24 @@ int runops_devel_profit(pTHX)
             diff = now - start;
             //printf("%s:%ld start=%.0f now=%.0f diff=%.0f\n", file, line, start, now, diff);
             if (line) {
-                if (hv_exists_ent(seen_file, file, 0)) {
-                    seen_file_number = HeVAL(hv_fetch_ent(seen_file, file, 0, 0));
-                    //printf("have seen file %s before: %d\n", SvPV_nolen(file), SvIV(seen_file_number));
+                if (profit_exists(seen_file, file)) {
+                    seen_file_number = profit_fetch(seen_file, file);
+                    //printf("have seen file %s before: %d\n", PROFITFILE2STR(file), SvIV(seen_file_number));
                 } else {
                     seen_file_number = newSViv(file_number);
-                    hv_store_ent(seen_file, file, seen_file_number, 0);
+                    profit_store(seen_file, file, seen_file_number);
                     file_number++;
-                    fprintf(fp, "%d=%s\n", SvIV(seen_file_number), SvPV_nolen(file));
-                    //printf("have not seen file %s before: %d\n", SvPV_nolen(file), SvIV(seen_file_number));
+                    fprintf(fp, "%d=%s\n", SvIV(seen_file_number), PROFITFILE2STR(file));
+                    //printf("have not seen file %s before: %d\n", PROFITFILE2STR(file), SvIV(seen_file_number));
                 }
                 fprintf(fp, "%d:%ld %.0f\n", SvIV(seen_file_number), line, diff);
-                //fprintf(fp, "%s:%ld %.0f\n", SvPV_nolen(file), line, diff);
+                //fprintf(fp, "%s:%ld %.0f\n", PROFITFILE2STR(file), line, diff);
             }
+#ifdef PROFIT_NO_FILE_SV
+            file = CopFILE(cCOP);
+#else
             file = CopFILESV(cCOP);
+#endif
             line = CopLINE(cCOP);
             start = now;
         }
@@ -70,3 +97,5 @@ BOOT:
         file_number = 1;
         start = get_clock();
         PL_runops = runops_devel_profit;
+        PL_perldb |= PERLDBf_LINE; //Second way to make this module work
+        QueryPerformanceFrequency(&time);
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Aug 16, 2015

From @bulk88

On Thu Jul 23 20​:00​:25 2015, bulk88 wrote​:

On Tue Jul 14 23​:50​:31 2015, tonyc wrote​:

This breaks Devel​::Profit, which I suspect will need a simple fix.

There are 3 potential ways to fix Devel​::Profit.

#1
PL_perldb |= PERLDBf_LINE;
*******stuff cut*************

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Oct 15, 2015

From @tonycoz

On Thu Jul 23 20​:00​:25 2015, bulk88 wrote​:

On Tue Jul 14 23​:50​:31 2015, tonyc wrote​:

This breaks Devel​::Profit, which I suspect will need a simple fix.

There are 3 potential ways to fix Devel​::Profit.
...
I attached patch for Profit.xs that does #1 and #3. Do you TonyC
actually use Devel​::Profit regularly or is was it just for testing?

I've never used it, it showed up when I used grep.cpan.me to try to see what the patch breaks.

I'm hesitant about applying the patch since I don't know what else it might break.

Does anyone else know of code this change might break?

Tony

@p5pRT
Copy link
Author

p5pRT commented Jan 28, 2016

From @rjbs

* bulk88 via RT <perlbug-followup@​perl.org> [2015-08-15T22​:04​:29]

Bump.

Bump. :-)

I've had this ticket flagged for a long time. I think it's reasonable for us
to be cautious in the face of no expertise, but right now it seems like "we're
not sure what's up, so we're doing nothing."

I wonder whether we're not better off trying it and seeing, lest this patch
languish forever. Alternately, would someone like to work on becoming an
expert on this area? :)

--
rjbs

@p5pRT
Copy link
Author

p5pRT commented Jan 29, 2016

From @bulk88

On Thu Jan 28 15​:01​:20 2016, perl.p5p@​rjbs.manxome.org wrote​:

* bulk88 via RT <perlbug-followup@​perl.org> [2015-08-15T22​:04​:29]

Bump.

Bump. :-)

I've had this ticket flagged for a long time. I think it's reasonable
for us
to be cautious in the face of no expertise, but right now it seems
like "we're
not sure what's up, so we're doing nothing."

I wonder whether we're not better off trying it and seeing, lest this
patch
languish forever. Alternately, would someone like to work on becoming
an
expert on this area? :)

This patch series is sort of a precursor to sharing HEKs between ithreads. I have to review what cperl does and if rurban came up with his own solution or not and what can be borrowed from it if it exists, but a COP's filename (used for all warning messages and perl debugger) is currently allocated, with threads, one malloc block per COP. That is insane. It means something like 25 bytes of overhead (lets round it to 32 or 64 bytes with malloc header), for almost EVERY line of perl source code with threads (lines that you can't set a breakpoint on, have no COP op and therefore no file name).

My initial plans for shared filenames, which are probably best implemented as a being a derivative of a HEK with a refcount as a struct field, with most of the fields being compatible with HEKs. struct refcounted_he, which looks like a "shared" rip off a SV looks too heavy weight. Filenames are always strings, not IVs. Storing a filename as a "dualvar" is insane. Who has a perl source code file, name "1"? Yes, no .pl, no .pm. Just a file called "1" on disk.

This part of taming source code file names in threaded perl got tamed, http​://perl5.git.perl.org/perl.git/commit/9b669ea1e2997fbb78558e1fc0a7ecae3aa23af0 but http​://perl5.git.perl.org/perl.git/commit/9b669ea1e2997fbb78558e1fc0a7ecae3aa23af0 was a part of a number of ideas I had.

Shared HEKs are also best implemented (but not necessarily first implemented) with atomic CPU op refcounts, instead of the current MUTEX_LOCK APIs in thread.h that use OS specific mutex function calls instead of CPU atomic instrinics. A global mutex for all SHEK opcounts is the first step, like a number of other things in perl core that would be best done with atomics but instead are done with a global mutex for changing the count of a particular instance of a global struct. I have a patch to add CC atomics to perl that I never finished.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Jan 29, 2016

From @lizmat

On 29 Jan 2016, at 12​:37, bulk88 via RT <perlbug-followup@​perl.org> wrote​:
(*snip*)
Who has a perl source code file, name "1"? Yes, no .pl, no .pm. Just a file called "1" on disk.

FWIW, I do. And “2”, and “3”. Simple stuff I use during testing. Throwawayable for sure.

Also, at former $work, we had a lot of log files of which the name was simply the POSIX epoch at which they were generated (one for every second).

Just my 2c

Liz

@p5pRT
Copy link
Author

p5pRT commented Feb 3, 2016

From @ap

* Elizabeth Mattijsen <liz@​dijkmat.nl> [2016-01-29 12​:55]​:

* On 29 Jan 2016, at 12​:37, bulk88 via RT <perlbug-followup@​perl.org> wrote​:

Who has a perl source code file, name "1"? Yes, no .pl, no .pm. Just
a file called "1" on disk.

FWIW, I do. And “2”, and “3”. Simple stuff I use during testing.
Throwawayable for sure.

Yeah. It wouldn’t do to restrict what filenames could be stored. But
bulk88 actually kinda missed his own point here – whether anybody has
files named like that is besides the point. This is what he wrote just
before the part you quoted​:

* bulk88 via RT <perlbug-followup@​perl.org> [2016-01-29 12​:40]​:

Filenames are always strings, not IVs. Storing a filename as
a "dualvar" is insane.

So filenames that are just numbers could still be stored, it would just
not be possible to convert them to actual integers. Which I agree with
him is… well, maybe not insane outright, but certainly a silly thing to
spend resources on.

@p5pRT
Copy link
Author

p5pRT commented Feb 4, 2016

From @tonycoz

On Thu Jan 28 15​:01​:20 2016, perl.p5p@​rjbs.manxome.org wrote​:

* bulk88 via RT <perlbug-followup@​perl.org> [2015-08-15T22​:04​:29]

Bump.

Bump. :-)

I've had this ticket flagged for a long time. I think it's reasonable
for us
to be cautious in the face of no expertise, but right now it seems
like "we're
not sure what's up, so we're doing nothing."

I wonder whether we're not better off trying it and seeing, lest this
patch
languish forever. Alternately, would someone like to work on becoming
an
expert on this area? :)

Saving up to 24K of memory (and usually less) when loading all of Test​::Harness, Test​::More, CPAN, CPAN​::Meta, ExtUtils​::MakeMaker and Pod​::Perldoc *and* their dependents doesn't seem worth the changes downstream code may need to make.

bulk88 provided a Devel​::Profit patch*, but what else does it break?

Tony

* which the maintainer can't use as is, since it breaks the code on non-Win32

@toddr
Copy link
Member

toddr commented Feb 13, 2020

The proposed patches ( bulk88/perl@ef023cf and bulk88/perl@1bb0899 ) no longer apply.

Given no response from @bulk88, I'm going to close this.

If we want to pursue it further, it sounds like Devel::Profit needs a patch and perhaps we should move this to a PR?

@toddr toddr closed this as completed Feb 13, 2020
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

2 participants