In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d9bb50d52d1ca3a07a2e812ec55d1165ea82d6d6?hp=109b7e48097d1bc00b162c55d646e7cd2c46562b>
- Log ----------------------------------------------------------------- commit d9bb50d52d1ca3a07a2e812ec55d1165ea82d6d6 Author: Daniel Dragan <[email protected]> Date: Sat Nov 22 17:11:20 2014 -0500 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 ----------------------------------------------------------------------- Summary of changes: dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 62 ++++++++++++++++++++++----- 1 file changed, 52 insertions(+), 10 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index d0429ed..8c7b09d 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -2021,36 +2021,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"; -- Perl5 Master Repository
