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

optimizing Perl_do_kv and Perl_magic_scalarpack, tied HV SCALAR method strangeness #13631

Closed
p5pRT opened this issue Feb 28, 2014 · 14 comments
Closed

Comments

@p5pRT
Copy link

p5pRT commented Feb 28, 2014

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

Searchable as RT121348$

@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2014

From @bulk88

Created by @bulk88

I ran across some strange looking code so I investigated. The SPAGAINs
and PUTBACKs can be removed since magic calls now swap stacks. But
removing the X from XPUSH is challenging. There is

" EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues));"

But it DOESNT extend the stack enough to avoid the X being called in
XPUSHs when executing

"our %Config = %Config​::Config;"

in ExtUtils\MakeMaker\Config.pm . I tried doing
------------------------
use Config;
use Data​::Dumper;
%h = ('a' => 1, 'b' =>2);
print(Dumper(scalar(%h)));
print(Dumper(scalar(%Config)));
------------------------
which gave

#############5.12
C​:\Documents and Settings\Owner\Desktop>perl n11.pl
$VAR1 = "2/8";
$VAR1 = 1;
#############5.19
C​:\Documents and Settings\Owner\Desktop>perl n11.pl
$VAR1 = '2/8';
$VAR1 = 1;

But %Config clearly doesn't have 1 key in it. Config_heavy.pl does not
have a SCALAR method, and it seem optional to have one per
Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) in mg.c. I found
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=18186 and
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=24798 which seem related to
the fact that SCALAR returns an IMMORTAL SV when there is no SCALAR sub
in the package, not the key and bucket counts. Is this intended behavior
or should it be revisted?

So is there a way to fix " EXTEND(SP, HvUSEDKEYS(keys) * (dokeys +
dovalues));" to remove the X from XPUSHs later in the sub and correctly
EXTEND for tied HVs? Calling SCALAR doesn't work on %Config.

Also Perl_magic_scalarpack seems to do the same stash lookup twice for
no good reason.

-------------------------------------------------------------
SV *
Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
{
  dVAR;
  SV *retval;
  SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
  HV * const pkg = SvSTASH((const SV *)SvRV(tied));

  PERL_ARGS_ASSERT_MAGIC_SCALARPACK;

  if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE))
{<<<<<<<<<<<<<<<FIRST TIME
  SV *key;
  if (HvEITER_get(hv))
  /* we are in an iteration so the hash cannot be empty */
  return &PL_sv_yes;
  /* no xhv_eiter so now use FIRSTKEY */
  key = sv_newmortal();
  magic_nextpack(MUTABLE_SV(hv), mg, key);
  HvEITER_set(hv, NULL); /* need to reset iterator */
  return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
  }

  /* there is a SCALAR method that we can call */
  retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg,
SV_CONST(SCALAR), 0, 0);<<<<<<<<<<<<SECOND TIME
  if (!retval)
  retval = &PL_sv_undef;
  return retval;
}
-------------------------------------------------------------

I did testing with the following patch. That is how I know the SPAGAIN
and PUTBACK can go. The extend check assert were so frequent they were
commented out so the stack realloc asserts can trip without noise.
harness did pass all tests with no crashes from stack realloc assert.
("DebugBreak()" is a C breakpoint function so harness stops because a
child perl proc crashed and I can examine the .t perl process with a C
debugger).

Perl Info

Flags:
category=core
severity=wishlist

Site configuration information for perl 5.19.9:

Configured by Owner at Wed Feb 12 06:47:30 2014.

Summary of my perl5 (revision 5 version 19 subversion 9) configuration:
Derived from: 633f0fd2ca244ca83cc99b3af3a7d3ac2931850b
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 -Od -MD -Zi -DDEBUGGING -DWIN32
-D_CONSOLE -DNO_STRICT -DPERL_TEXTMODE_SCRIPTS
-DPERL_HASH_FUNC_ONE_AT_A_TIME -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T',
optimize='-Od -MD -Zi -DDEBUGGING',
cppflags='-DWIN32'
ccversion='13.10.6030', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8
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
-libpath:"c:\perl519\lib\CORE" -machine:x86'
libpth="C:\Program Files\Microsoft Visual Studio .NET 2003\VC7\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=perl519.lib
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug
-libpath:"c:\perl519\lib\CORE" -machine:x86'

Locally applied patches:
uncommitted-changes


@INC for perl 5.19.9:
C:/perl519/site/lib
C:/perl519/lib
.


Environment for perl 5.19.9:
HOME (unset)
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=C:\perl519\bin;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\IDE;C:\Program Files\Microsoft Visual Studio .NET
2003\VC7\BIN;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\Tools;C:\Program Files\Microsoft Visual Studio .NET
2003\Common7\Tools\bin\prerelease;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\system32\wbem;
PERL_BADLANG (unset)
SHELL (unset)




@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2014

From @bulk88

0001-Perl_do_kv-hacking.patch
From 93b9a6af5395469274297415f4e135b326c08d89 Mon Sep 17 00:00:00 2001
From: bulk88 <bulk88@hotmail.com>
Date: Thu, 27 Feb 2014 21:43:47 -0500
Subject: [PATCH] Perl_do_kv hacking

---
 doop.c |    9 ++++++++-
 1 files changed, 8 insertions(+), 1 deletions(-)

diff --git a/doop.c b/doop.c
index 5031af8..2a908d3 100644
--- a/doop.c
+++ b/doop.c
@@ -1230,6 +1230,7 @@ Perl_do_kv(pTHX)
     dSP;
     HV * const keys = MUTABLE_HV(POPs);
     HE *entry;
+    SV ** sprealloc;
     const I32 gimme = GIMME_V;
     const I32 dokv =     (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
     /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
@@ -1268,14 +1269,18 @@ Perl_do_kv(pTHX)
     EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues));
 
     PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
-    while ((entry = hv_iternext(keys))) {
+    while ((sprealloc = SP), (entry = hv_iternext(keys))) {
 	SPAGAIN;
+        if(SP != sprealloc) DebugBreak();
 	if (dokeys) {
 	    SV* const sv = hv_iterkeysv(entry);
+            // "our %Config = %Config::Config;" in ExtUtils\MakeMaker\Config.pm triggers this
+            //if(PL_stack_max - SP < (SSize_t)(1)) DebugBreak();//op/magic.t porting/cmp_version.t porting/utils.t files to run to trigger
 	    XPUSHs(sv);	/* won't clobber stack_sp */
 	}
 	if (dovalues) {
 	    SV *tmpstr;
+            sprealloc = SP;
 	    PUTBACK;
 	    tmpstr = hv_iterval(keys,entry);
 	    DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
@@ -1283,6 +1288,8 @@ Perl_do_kv(pTHX)
 			    (int)HvMAX(keys)+1,
 			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
 	    SPAGAIN;
+            if(SP != sprealloc) DebugBreak();
+            //if(PL_stack_max - SP < (SSize_t)(1)) DebugBreak(); //op/magic.t porting/cmp_version.t porting/utils.t
 	    XPUSHs(tmpstr);
 	}
 	PUTBACK;
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2014

From @iabyn

On Thu, Feb 27, 2014 at 06​:50​:51PM -0800, bulk88 wrote​:

and PUTBACKs can be removed since magic calls now swap stacks. But
removing the X from XPUSH is challenging. There is

" EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues));"

But it DOESNT extend the stack enough to avoid the X being called in
XPUSHs when executing

"our %Config = %Config​::Config;"

So is there a way to fix " EXTEND(SP, HvUSEDKEYS(keys) * (dokeys +
dovalues));" to remove the X from XPUSHs later in the sub and correctly
EXTEND for tied HVs? Calling SCALAR doesn't work on %Config.

I think the behaviour is fine the way it is. For the non-tied case,
the initial EXTEND is efficient, and the extra overhead of the X is
trivial. For the tied case, we don't really care about efficiency (or
rather, any savings from removing the X are completely dwarfed by
calling out to HASHNEXT each time).

Calling SCALAR to allow pre-extending would be inappropriate.

--
"You're so sadly neglected, and often ignored.
A poor second to Belgium, When going abroad."
  -- Monty Python, "Finland"

@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2014

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

@p5pRT
Copy link
Author

p5pRT commented Feb 28, 2014

From @iabyn

On Thu, Feb 27, 2014 at 06​:50​:51PM -0800, bulk88 wrote​:

Also Perl_magic_scalarpack seems to do the same stash lookup twice for
no good reason.

-------------------------------------------------------------
SV *
Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
{
dVAR;
SV *retval;
SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
HV * const pkg = SvSTASH((const SV *)SvRV(tied));

 PERL\_ARGS\_ASSERT\_MAGIC\_SCALARPACK;

 if \(\!gv\_fetchmethod\_autoload\(pkg\, "SCALAR"\, FALSE\)\) 

{<<<<<<<<<<<<<<<FIRST TIME
SV *key;
if (HvEITER_get(hv))
/* we are in an iteration so the hash cannot be empty */
return &PL_sv_yes;
/* no xhv_eiter so now use FIRSTKEY */
key = sv_newmortal();
magic_nextpack(MUTABLE_SV(hv), mg, key);
HvEITER_set(hv, NULL); /* need to reset iterator */
return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
}

 /\* there is a SCALAR method that we can call \*/
 retval = Perl\_magic\_methcall\(aTHX\_ MUTABLE\_SV\(hv\)\, mg\, 

SV_CONST(SCALAR), 0, 0);<<<<<<<<<<<<SECOND TIME
if (!retval)
retval = &PL_sv_undef;
return retval;
}

Presumably because the usual API for magic calls, Perl_magic_methcall()
does its own method lookup, while unusually, magic_scalarpack has
special handling for when the SCALAR method doesn't exist, so has to do
it's own check first. Not 100% efficient, but trivial compared with the
cost that's about to be bourne by calling out to SCALAR.

--
Wesley Crusher gets beaten up by his classmates for being a smarmy git,
and consequently has a go at making some friends of his own age for a
change.
  -- Things That Never Happen in "Star Trek" #18

@p5pRT
Copy link
Author

p5pRT commented Mar 9, 2014

From @bulk88

On Fri Feb 28 03​:48​:40 2014, davem wrote​:

I think the behaviour is fine the way it is. For the non-tied case,
the initial EXTEND is efficient, and the extra overhead of the X is
trivial. For the tied case, we don't really care about efficiency (or
rather, any savings from removing the X are completely dwarfed by
calling out to HASHNEXT each time).

Calling SCALAR to allow pre-extending would be inappropriate.

Ok, removing the per key EXTEND is impossible. I attached a WIP patch of my cleanup of Perl_do_kv. 1 small issue is, there is a feature I accidentally put in. Read the comment with XXX. IDK whether to delete it without a trace, leave it as comments, or put the ASSUME. Since it might not be obvious to the next person this provision/feature exists. Or this feature makes no sense to remove it and assert it?

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Mar 9, 2014

From @bulk88

0001-WIP-Perl_do_kv-refactoring.patch
From eaa4efa21258323fe01a1187b094e7a22c56dde3 Mon Sep 17 00:00:00 2001
From: bulk88 <bulk88@hotmail.com>
Date: Sun, 9 Mar 2014 16:30:12 -0400
Subject: [PATCH] WIP Perl_do_kv refactoring

-move GIMME_V closet to first and last use
-if G_VOID, don't calculate the type of do, just return
-in G_SCALAR, factor 2 SP++s out into 2, use SETs later on
-move dTARGET closer to first use to save registers, targ is not saved
 across any function calls now
-in G_ARRAY, simplify op_type to do type conversion,  "dokv ||" logic
 looked less than ideal for perf
-unknown op_type gets NOT_REACHED, a smoke by me shows it wasn't reached
 so the 6 op_types are the whole list of what will call this
-do_kind constants are 1 char for compact machine code encoding, a 2 byte
 litteral in C is often a 4 byte litteral in various machine code b/c
 16 bit operands aren't implemented
-the 2 "X" on XPUSH are factored out into 1 EXTEND, the overhead of
 choosing 1 vs 2 isn't worth it, because the real extend size is much
 larger in Perl_stack_grow
-remove the SPAGAIN/PUTBACK which dates from commit 463ee0b2ac alpha 4,
 isn't needed since magic nowadays swaps perl stacks

On my Win32 VC 2003 x86-32 machine code size decreased from 0x282 to 0x1EB
with this patch.
---
 doop.c |   89 +++++++++++++++++++++++++++++++++++++++------------------------
 1 files changed, 55 insertions(+), 34 deletions(-)

diff --git a/doop.c b/doop.c
index 5031af8..869bfff 100644
--- a/doop.c
+++ b/doop.c
@@ -1228,31 +1228,25 @@ Perl_do_kv(pTHX)
 {
     dVAR;
     dSP;
+    I32 gimme;
     HV * const keys = MUTABLE_HV(POPs);
-    HE *entry;
-    const I32 gimme = GIMME_V;
-    const I32 dokv =     (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
-    /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
-    const I32 dokeys =   dokv || (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS);
-    const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES);
-
     (void)hv_iterinit(keys);	/* always reset iterator regardless */
 
+    gimme = GIMME_V;
     if (gimme == G_VOID)
 	RETURN;
 
     if (gimme == G_SCALAR) {
+	SP++; /* part of SETs */
 	if (PL_op->op_flags & OPf_MOD || LVRET) {	/* lvalue */
 	    SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));  /* Not TARG RT#67838 */
 	    sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0);
 	    LvTYPE(ret) = 'k';
 	    LvTARG(ret) = SvREFCNT_inc_simple(keys);
-	    PUSHs(ret);
+	    SETs(ret);
 	}
 	else {
 	    IV i;
-	    dTARGET;
-
 	    if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) {
 		i = HvUSEDKEYS(keys);
 	    }
@@ -1260,34 +1254,61 @@ Perl_do_kv(pTHX)
 		i = 0;
 		while (hv_iternext(keys)) i++;
 	    }
-	    PUSHi( i );
+            {
+                dTARGET;
+                SETs(targ);
+                sv_setiv_mg(targ , i);
+            }
 	}
-	RETURN;
     }
-
-    EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues));
-
-    PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
-    while ((entry = hv_iternext(keys))) {
-	SPAGAIN;
-	if (dokeys) {
-	    SV* const sv = hv_iterkeysv(entry);
-	    XPUSHs(sv);	/* won't clobber stack_sp */
+    else {
+/* A = G_ARRAY */
+#define DOKVA_KEYS 0x1
+#define DOKVA_VALUES 0x2
+	HE *entry;
+    /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
+	const I32 usedkeys = HvUSEDKEYS(keys);
+	/* do_kind, low nibble is bf, high nibble is extend multiplier,
+	   times 3 on stack extend might cause out of memory error in rare case
+	*/
+	U8 do_kind = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
+			    ? 2<<4|DOKVA_KEYS|DOKVA_VALUES
+			    : (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS)
+			    ? 1<<4|DOKVA_KEYS
+			    :(PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES)
+			    ? 1<<4|DOKVA_VALUES : (NOT_REACHED,0);
+	{
+	    const U32 extend_mul = do_kind & 0xf0;
+	    do_kind ^= extend_mul; /* remove extend_mul nibble from bf */
+	    EXTEND(SP, usedkeys * extend_mul);
 	}
-	if (dovalues) {
-	    SV *tmpstr;
-	    PUTBACK;
-	    tmpstr = hv_iterval(keys,entry);
-	    DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
-			    (unsigned long)HeHASH(entry),
-			    (int)HvMAX(keys)+1,
-			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
-	    SPAGAIN;
-	    XPUSHs(tmpstr);
+
+	while (entry = hv_iternext(keys)) {
+/* XXX remove or comment the next line out, since this "feature" doesn't exist
+  because do_kind can never be set to 0, because branch 0 is NOT_REACHED, or
+  ASSUME(do_kind) it to neutralize the branch, if the code is found to be
+  needed (DEBUGGING failed), then ASSUME can be removed ???? */
+	    if(do_kind) {
+		EXTEND(SP,2); /* overextend by 1 sometimes won't hurt */
+		if (do_kind & DOKVA_KEYS) {
+		    SV* const sv = hv_iterkeysv(entry);
+		    PUSHs(sv);
+		}
+		if (do_kind & DOKVA_VALUES) {
+		    SV *tmpstr;
+		    tmpstr = hv_iterval(keys,entry);
+		    DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
+				    (unsigned long)HeHASH(entry),
+				    (int)HvMAX(keys)+1,
+				    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
+		    PUSHs(tmpstr);
+		}
+	    }
 	}
-	PUTBACK;
-    }
-    return NORMAL;
+#undef DOKVA_KEYS
+#undef DOKVA_VALUES
+    } /* else/G_ARRAY */
+    RETURN;
 }
 
 /*
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Mar 10, 2014

From @iabyn

On Sun, Mar 09, 2014 at 01​:43​:00PM -0700, bulk88 via RT wrote​:

Ok, removing the per key EXTEND is impossible. I attached a WIP patch of
my cleanup of Perl_do_kv. 1 small issue is, there is a feature I
accidentally put in. Read the comment with XXX. IDK whether to delete it
without a trace, leave it as comments, or put the ASSUME. Since it might
not be obvious to the next person this provision/feature exists. Or this
feature makes no sense to remove it and assert it?

Given that it makes no sense for Perl_do_kv() to be called without
pushing at least one of keys or values, a simple assert should suffice.

Encoding the multiplier in the high nibble seems a bit tricksy. Couldn't
you just have​:

  EXTEND(SP, usedkeys * (1 + (do_kind == (DOKVA_KEYS|DOKVA_VALUES)));

--
I thought I was wrong once, but I was mistaken.

@p5pRT
Copy link
Author

p5pRT commented Mar 14, 2014

From @bulk88

On Mon Mar 10 06​:44​:20 2014, davem wrote​:

On Sun, Mar 09, 2014 at 01​:43​:00PM -0700, bulk88 via RT wrote​:

Ok, removing the per key EXTEND is impossible. I attached a WIP patch of
my cleanup of Perl_do_kv. 1 small issue is, there is a feature I
accidentally put in. Read the comment with XXX. IDK whether to delete it
without a trace, leave it as comments, or put the ASSUME. Since it might
not be obvious to the next person this provision/feature exists. Or this
feature makes no sense to remove it and assert it?

Given that it makes no sense for Perl_do_kv() to be called without
pushing at least one of keys or values, a simple assert should suffice.

Encoding the multiplier in the high nibble seems a bit tricksy. Couldn't
you just have​:

EXTEND\(SP\, usedkeys \* \(1 \+ \(do\_kind == \(DOKVA\_KEYS|DOKVA\_VALUES\)\)\);

New final patch attached.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Mar 14, 2014

From @bulk88

On Fri Mar 14 12​:11​:56 2014, bulk88 wrote​:

New final patch attached.

Forgot attachment.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Mar 14, 2014

From @bulk88

0001-Perl_do_kv-refactoring.patch
From c0f0b1497217bd7221bd4f915b41b8005b60bf5d Mon Sep 17 00:00:00 2001
From: bulk88 <bulk88@hotmail.com>
Date: Fri, 14 Mar 2014 14:53:13 -0400
Subject: [PATCH] Perl_do_kv refactoring

-move GIMME_V closet to first and last use
-if G_VOID, don't calculate the type of do, just return
-in G_SCALAR, factor 2 SP++s out into 1, use SETs later on
-move dTARGET closer to first use to save registers, targ is not saved
 across any function calls now
-in G_ARRAY, simplify op_type to do type conversion,  "dokv ||" logic
 looked less than ideal for perf
-unknown op_type gets NOT_REACHED, a smoke by me shows it wasn't reached
 so the 6 op_types are the whole list of what will call this
-do_kind constants are 1 char for compact machine code encoding
-the 2 "X" on XPUSH are factored out into 1 EXTEND, the overhead of
 choosing 1 vs 2 isn't worth it, because the real extend size is much
 larger in Perl_stack_grow
-remove the SPAGAIN/PUTBACK which dates from commit 463ee0b2ac alpha 4,
 isn't needed since magic nowadays swaps perl stacks

On my Win32 VC 2003 x86-32 machine code size decreased from 0x282 to 0x1FD
with this patch.
---
 doop.c |   80 ++++++++++++++++++++++++++++++++++++----------------------------
 1 files changed, 45 insertions(+), 35 deletions(-)

diff --git a/doop.c b/doop.c
index 5031af8..f4c1474 100644
--- a/doop.c
+++ b/doop.c
@@ -1228,31 +1228,25 @@ Perl_do_kv(pTHX)
 {
     dVAR;
     dSP;
+    I32 gimme;
     HV * const keys = MUTABLE_HV(POPs);
-    HE *entry;
-    const I32 gimme = GIMME_V;
-    const I32 dokv =     (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
-    /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
-    const I32 dokeys =   dokv || (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS);
-    const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES);
-
     (void)hv_iterinit(keys);	/* always reset iterator regardless */
 
+    gimme = GIMME_V;
     if (gimme == G_VOID)
 	RETURN;
 
     if (gimme == G_SCALAR) {
+	SP++; /* part of SETs */
 	if (PL_op->op_flags & OPf_MOD || LVRET) {	/* lvalue */
 	    SV * const ret = sv_2mortal(newSV_type(SVt_PVLV));  /* Not TARG RT#67838 */
 	    sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0);
 	    LvTYPE(ret) = 'k';
 	    LvTARG(ret) = SvREFCNT_inc_simple(keys);
-	    PUSHs(ret);
+	    SETs(ret);
 	}
 	else {
 	    IV i;
-	    dTARGET;
-
 	    if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) {
 		i = HvUSEDKEYS(keys);
 	    }
@@ -1260,34 +1254,50 @@ Perl_do_kv(pTHX)
 		i = 0;
 		while (hv_iternext(keys)) i++;
 	    }
-	    PUSHi( i );
+	    {
+		dTARGET;
+		SETs(targ);
+		sv_setiv_mg(targ , i);
+	    }
 	}
-	RETURN;
     }
-
-    EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues));
-
-    PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
-    while ((entry = hv_iternext(keys))) {
-	SPAGAIN;
-	if (dokeys) {
-	    SV* const sv = hv_iterkeysv(entry);
-	    XPUSHs(sv);	/* won't clobber stack_sp */
-	}
-	if (dovalues) {
-	    SV *tmpstr;
-	    PUTBACK;
-	    tmpstr = hv_iterval(keys,entry);
-	    DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
-			    (unsigned long)HeHASH(entry),
-			    (int)HvMAX(keys)+1,
-			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
-	    SPAGAIN;
-	    XPUSHs(tmpstr);
+    else {
+/* A = G_ARRAY */
+#define DOKVA_KEYS 0x1
+#define DOKVA_VALUES 0x2
+	HE *entry;
+    /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
+	const I32 usedkeys = HvUSEDKEYS(keys);
+	U8 do_kind = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
+			    ? DOKVA_KEYS|DOKVA_VALUES
+			    : (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS)
+			    ? DOKVA_KEYS
+			    :(PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES)
+			    ? DOKVA_VALUES : (NOT_REACHED,0);
+	ASSUME(do_kind != 0);
+	EXTEND(SP, usedkeys * (1+(do_kind == (DOKVA_KEYS|DOKVA_VALUES))));
+
+	while (entry = hv_iternext(keys)) {
+	    ASSUME(do_kind != 0);
+	    EXTEND(SP,2); /* overextend by 1 sometimes won't hurt */
+	    if (do_kind & DOKVA_KEYS) {
+		SV* const sv = hv_iterkeysv(entry);
+		PUSHs(sv);
+	    }
+	    if (do_kind & DOKVA_VALUES) {
+		SV *tmpstr;
+		tmpstr = hv_iterval(keys,entry);
+		DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu",
+				(unsigned long)HeHASH(entry),
+				(int)HvMAX(keys)+1,
+				(unsigned long)(HeHASH(entry) & HvMAX(keys))));
+		PUSHs(tmpstr);
+	    }
 	}
-	PUTBACK;
-    }
-    return NORMAL;
+#undef DOKVA_KEYS
+#undef DOKVA_VALUES
+    } /* else/G_ARRAY */
+    RETURN;
 }
 
 /*
-- 
1.7.9.msysgit.0

@p5pRT
Copy link
Author

p5pRT commented Sep 21, 2015

From @bulk88

On Fri Mar 14 12​:12​:28 2014, bulk88 wrote​:

On Fri Mar 14 12​:11​:56 2014, bulk88 wrote​:

New final patch attached.

Forgot attachment.

Bump.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Sep 23, 2015

From @tonycoz

On Fri Mar 14 12​:12​:28 2014, bulk88 wrote​:

On Fri Mar 14 12​:11​:56 2014, bulk88 wrote​:

New final patch attached.

Forgot attachment.

-in G_ARRAY, simplify op_type to do type conversion, "dokv ||" logic
looked less than ideal for perf

- const I32 dokv = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV);
- /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
- const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS);
- const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES);

+ U8 do_kind = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV)
+ ? DOKVA_KEYS|DOKVA_VALUES
+ : (PL_op->op_type == OP_KEYS || PL_op->op_type == OP_RKEYS)
+ ? DOKVA_KEYS
+ :(PL_op->op_type == OP_VALUES || PL_op->op_type == OP_RVALUES)
+ ? DOKVA_VALUES : (NOT_REACHED,0);

I don't think I'd call that simplified. Just moving it and using bool for the do* variables would be preferable.

-unknown op_type gets NOT_REACHED, a smoke by me shows it wasn't reached
so the 6 op_types are the whole list of what will call this

The ASSUME() you've added will assert on this for DEBUGGING builds.

+ const I32 usedkeys = HvUSEDKEYS(keys);

I32 is the devil, this should be STRLEN (or maybe SSize_t). HvUSEDKEYS() is the difference between
xhv_keys (STRLEN) and Perl_hv_placeholders_get() (I32) (or possibly 0), so it may not fit in an I32.

+ ASSUME(do_kind != 0);
+ EXTEND(SP, usedkeys * (1+(do_kind == (DOKVA_KEYS|DOKVA_VALUES))));
+
+ while (entry = hv_iternext(keys)) {
+ ASSUME(do_kind != 0);
+ EXTEND(SP,2); /* overextend by 1 sometimes won't hurt */

Why ASSUME(do_kind != 0); twice?

Tony

@toddr
Copy link
Member

toddr commented Feb 13, 2020

@bulk88 This patch no longer applies. If you are interested in pursuing it, can you please open a PR for further discussion?

@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