[PATCH] improve ParseXS RETVAL code gen

[p5pRT]

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

Searchable as RT123278$

[p5pRT]

From @bulk88

Created by @bulk88

Need #. attached CSV shows reductions of .text section of core xs dlls after this patch. I tracked down the bizzare increase in size of perl521.dll to be that somehow the "before" blead was compiled to not be git aware\, so -V/Internals​::Minus doesn't list "registered patches"\, the after lists "registered patches". The patch obviously takes priority of the readability of the generated .c file over simpleness in parsexs since there wasn't a yes or no answer in the ML thread.

Perl Info

``` Flags: category=core severity=low Site configuration information for perl 5.21.4: Configured by Owner at Thu Sep 18 12:08:58 2014. Summary of my perl5 (revision 5 version 21 subversion 4) configuration: Derived from: 7d2b2edb94ab56333b9049a3e26d15ea18445512 Ancestor: 19be3be6968e2337bcdfe480693fff795ecd1304 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 -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='-O1 -MD -Zi -DNDEBUG', cppflags='-DWIN32' ccversion='12.00.8168', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 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 -libpath:"c:\perl521\lib\CORE" -machine:x86' libpth=C:\PROGRA~1\MIAF9D~1\VC98\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=perl521.lib gnulibc_version='' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -libpath:"c:\perl521\lib\CORE" -machine:x86' Locally applied patches: uncommitted-changes a0fe7a7e75de29e59f1da0d6822dc06e5be658fe a261faffee83d0145642ab5d1d046c9f813bc497 6506ab86ad1602a9ca720fcd30446dce1461d23d 7d2b2edb94ab56333b9049a3e26d15ea18445512 @INC for perl 5.21.4: lib C:/perl521/srcnew/lib . Environment for perl 5.21.4: HOME (unset) LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH= PERL_BADLANG (unset) PERL_JSON_BACKEND=Cpanel::JSON::XS PERL_YAML_BACKEND=YAML SHELL (unset) ```

[p5pRT]

From @bulk88

benefit.csv

[p5pRT]

From @bulk88

patch attached

[p5pRT]

From @bulk88

0001-improve-ParseXS-RETVAL-code-gen.patch

```diff From c8240f01b7a2b913fbf842416f38fd4b4e2d7ec5 Mon Sep 17 00:00:00 2001 From: Daniel Dragan Date: Sat, 22 Nov 2014 17:11:20 -0500 Subject: [PATCH] improve ParseXS RETVAL code gen This patch avoids using ST(0) repeatedly in the OUTPUT section for RETVAL. ST() include a read of global PL_stack_base. This read must be done between every function call per C lang. XSRETURN also contains a PL_stack_base read. sv_2mortal returns the incoming SV, the retval was previously ignored and ST was used again. This patch reduced the number of ST references to exactly 1, per RETVAL. The PL_stack_base reference in XSRETURN will be optimized into the PL_stack_base reference in ST(0). Using the retval of sv_2mortal allows the SV* to stay in a cheaper volatile register. In a sequence of "RETVALSV = newSViv(RETVAL); RETVALSV = sv_2mortal(RETVALSV); ST(0) = RETVALSV; XSRETURN(1);" RETVALSV never had to be saved around a function call. Also ST(0) in a multi eval macro with different function calls in it, will cause more PL_stack_base reads, so badly written user supplied typemaps get optimized since a C auto that never had & done on it is guarenteed to not change between function calls. To produce cleaner C code, indenting cleanup is done, and if RETVAL is a SV *, RETVALSV isn't created. Also if no additional boilerplate lines like sv_2mortal are added, RETVALSV isn't created. See [perl #123278] for details on machine code reductions that this patch caused and also see http://www.nntp.perl.org/group/perl.perl5.porters/2014/11/msg222342.html --- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 62 +++++++++++++++++++++---- 1 files changed, 52 insertions(+), 10 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 75feda5..c436e11 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -2019,36 +2019,78 @@ sub generate_output { print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic; } elsif ($var eq 'RETVAL') { + my $orig_arg = $arg; + my $indent; + my $use_RETVALSV = 1; + my $do_mortal = 0; + my $do_copy_tmp = 1; + my $pre_expr; + local $eval_vars->{arg} = $arg = 'RETVALSV'; my $evalexpr = $self->eval_output_typemap_code("qq\a$expr\a", $eval_vars); + if ($expr =~ /^\t\Q$arg\E = new/) { # We expect that $arg has refcnt 1, so we need to # mortalize it. - print $evalexpr; - print "\tsv_2mortal(ST($num));\n"; - print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic; + $do_mortal = 1; } # If RETVAL is immortal, don't mortalize it. This code is not perfect: # It won't detect a func or expression that only returns immortals, for # example, this RE must be tried before next elsif. elsif ($evalexpr =~ /^\t\Q$arg\E\s*=\s*(boolSV\(|(&PL_sv_yes|&PL_sv_no|&PL_sv_undef)\s*;)/) { - print $evalexpr; + $do_copy_tmp = 0; #$arg will be a ST(X), no SV* RETVAL, no RETVALSV + $use_RETVALSV = 0; } elsif ($evalexpr =~ /^\s*\Q$arg\E\s*=/) { # We expect that $arg has refcnt >=1, so we need # to mortalize it! - print $evalexpr; - print "\tsv_2mortal(ST(0));\n"; - print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; + $use_RETVALSV = 0 if $ntype eq "SVPtr";#reuse SV* RETVAL vs open new block + $do_mortal = 1; } else { # Just hope that the entry would safely write it # over an already mortalized value. By - # coincidence, something like $arg = &sv_undef + # coincidence, something like $arg = &PL_sv_undef # works too, but should be caught above. - print "\tST(0) = sv_newmortal();\n"; - print $evalexpr; + $pre_expr = "RETVALSV = sv_newmortal();\n"; # new mortals don't have set magic + $do_setmagic = 0; + } + if($use_RETVALSV) { + print "\t{\n\t SV * RETVALSV;\n"; + $indent = "\t "; + } else { + $indent = "\t"; + } + print $indent.$pre_expr if $pre_expr; + + if($use_RETVALSV) { + #take control of 1 layer of indent, may or may not indent more + $evalexpr =~ s/^(\t| )/$indent/gm; + #"\t \t" doesn't draw right in some IDEs + #break down all \t into spaces + $evalexpr =~ s/\t/ /g; + #rebuild back into \t'es, \t==8 spaces, indent==4 spaces + $evalexpr =~ s/ /\t/g; + } + else { + if($do_mortal || $do_setmagic) { + #typemap entry evaled with RETVALSV, if we aren't using RETVALSV replace + $evalexpr =~ s/RETVALSV/RETVAL/g; #all uses with RETVAL for prettier code + } + else { #if no extra boilerplate (no mortal, no set magic) is needed + #after $evalexport, get rid of RETVALSV's visual cluter and change + $evalexpr =~ s/RETVALSV/$orig_arg/g;#the lvalue to ST(X) + } } + #stop " RETVAL = RETVAL;" for SVPtr type + print $evalexpr if $evalexpr !~ /^\s*RETVAL = RETVAL;$/; + print $indent.'RETVAL'.($use_RETVALSV ? 'SV':'') + .' = sv_2mortal(RETVAL'.($use_RETVALSV ? 'SV':'').");\n" if $do_mortal; + print $indent.'SvSETMAGIC(RETVAL'.($use_RETVALSV ? 'SV':'').");\n" if $do_setmagic; + #dont do "RETVALSV = boolSV(RETVAL); ST(0) = RETVALSV;", it is visual clutter + print $indent."$orig_arg = RETVAL".($use_RETVALSV ? 'SV':'').";\n" + if $do_mortal || $do_setmagic || $do_copy_tmp; + print "\t}\n" if $use_RETVALSV; } elsif ($do_push) { print "\tPUSHs(sv_newmortal());\n"; -- 1.7.9.msysgit.0 ```

[p5pRT]

From @tonycoz

On Sat\, 22 Nov 2014 17​:04​:02​:

The patch obviously takes priority of the readability of the generated .c file over simpleness in parsexs since there wasn't a yes or no answer in the ML thread.

Both responses indicated that both should remain readable\, I thought.

http​://www.nntp.perl.org/group/perl.perl5.porters/2014/11/msg222342.html

That said\, I think you haven't obfuscated either with this patch.

On Sat Nov 22 14​:14​:23 2014\, bulk88 wrote​:

patch attached

I like this patch\, though I see one thing that might be improvable\, you have a comment​:

+ #dont do "RETVALSV = boolSV(RETVAL); ST(0) = RETVALSV;"\, it is visual clutter + print $indent."$orig_arg = RETVAL".($use_RETVALSV ? 'SV'​:'').";\n" + if $do_mortal || $do_setmagic || $do_copy_tmp;

but you're producing code like​:

#line 5512 "APItest.c"   RETVAL = sv_2mortal(RETVAL);   ST(0) = RETVAL;

and​:

  RETVALSV = sv_2mortal(RETVALSV);   ST(0) = RETVALSV;

but fixing this might make ParseXS too confusing.

I'll apply this in a few days\, unless someone objects.

Tony

[p5pRT]

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

[p5pRT]

From @bulk88

On Sun Nov 23 16​:38​:51 2014\, tonyc wrote​:

On Sat\, 22 Nov 2014 17​:04​:02​:

The patch obviously takes priority of the readability of the generated .c file over simpleness in parsexs since there wasn't a yes or no answer in the ML thread.

Both responses indicated that both should remain readable\, I thought.

I was looking for a yes or not answer. Saying both means no opinion. If the answer was PXS must be cleaner\, RETVALSV and the new scope would always exist. var $indent wouldn't exist\, no s/// RETVALSV to SV* RETVAL\, etc

I like this patch\, though I see one thing that might be improvable\, you have a comment​:

+ #dont do "RETVALSV = boolSV(RETVAL); ST(0) = RETVALSV;"\, it is visual clutter + print $indent."$orig_arg = RETVAL".($use_RETVALSV ? 'SV'​:'').";\n" + if $do_mortal || $do_setmagic || $do_copy_tmp;

but you're producing code like​:

#line 5512 "APItest.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL;

and​:

RETVALSV = sv_2mortal(RETVALSV); ST(0) = RETVALSV;

but fixing this might make ParseXS too confusing.

Yes too confusing. To fix that would mean creating a new sub that takes a stack/@​ of hashes/entries\, with placeholders in each expr the has for LVALUE/OUT RVALUE/IN and looking if any future entries exist\, and the sub looks at how many remaining entries elements exist for emitting\, it also adds the final assignment to ST(0)/$orig_arg/$arg/w/e if last expr in the last has no LVALUE in it. ParseXS is a "preprocessor"\, not a "compiler"\, I am not turning it into a "compiler" or a C compiler or teaching it to emit RTL then send it through a "C back end"\, atleast not yet.

PS\, is there any demand for written XS in Fortran or Pascal? Both have linking compatibility with C object code. Should regen.pl make proto.pas and proto.f?

http​://gcc.gnu.org/onlinedocs/gfortran/Interoperable-Subroutines-and-Functions.html

I kid I kid.

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @tonycoz

On Sat Nov 22 14​:14​:23 2014\, bulk88 wrote​:

patch attached

Not a few days\, thanks\, applied as d9bb50d52d1ca3a07a2e812ec55d1165ea82d6d6.

Tony

[p5pRT]

@tonycoz - Status changed from 'open' to 'resolved'