From: Gurusamy Sarathy Date: Sun, 19 Sep 1999 21:30:18 +0000 (+0000) Subject: avoid clearing @_ at all for faster subroutine calls; fix bugs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d8b46c1bb1e2856c8ae13cfa7f0b032537c8f918;p=p5sagit%2Fp5-mst-13.2.git avoid clearing @_ at all for faster subroutine calls; fix bugs in passing around references to @_, eg C; add tests for the same p4raw-id: //depot/perl@4195 --- diff --git a/MANIFEST b/MANIFEST index 06135b8..bb92930 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1236,6 +1236,7 @@ t/lib/timelocal.t See if Time::Local works t/lib/trig.t See if Math::Trig works t/op/64bit.t See if 64 bitness works t/op/append.t See if . works +t/op/args.t See if operations on @_ work t/op/arith.t See if arithmetic works t/op/array.t See if array operations work t/op/assignwarn.t See if OP= operators warn correctly for undef targets diff --git a/cop.h b/cop.h index 6ea045a..e8221b6 100644 --- a/cop.h +++ b/cop.h @@ -66,17 +66,22 @@ struct block_sub { #define POPSAVEARRAY() \ STMT_START { \ SvREFCNT_dec(GvAV(PL_defgv)); \ - GvAV(PL_defgv) = cxsub.savearray; \ + GvAV(PL_defgv) = cxsub.savearray; \ } STMT_END #endif /* USE_THREADS */ #define POPSUB2() \ if (cxsub.hasargs) { \ POPSAVEARRAY(); \ - /* destroy arg array */ \ - av_clear(cxsub.argarray); \ - AvREAL_off(cxsub.argarray); \ - AvREIFY_on(cxsub.argarray); \ + /* abandon @_ if it got reified */ \ + if (AvREAL(cxsub.argarray)) { \ + SSize_t fill = AvFILLp(cxsub.argarray); \ + SvREFCNT_dec(cxsub.argarray); \ + cxsub.argarray = newAV(); \ + av_extend(cxsub.argarray, fill); \ + AvFLAGS(cxsub.argarray) = AVf_REIFY; \ + PL_curpad[0] = (SV*)cxsub.argarray; \ + } \ } \ if (cxsub.cv) { \ if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth)) \ diff --git a/pp.c b/pp.c index 07bb33d..6746aa5 100644 --- a/pp.c +++ b/pp.c @@ -530,6 +530,12 @@ S_refto(pTHX_ SV *sv) else (void)SvREFCNT_inc(sv); } + else if (SvTYPE(sv) == SVt_PVAV) { + if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv)) + av_reify((AV*)sv); + SvTEMP_off(sv); + (void)SvREFCNT_inc(sv); + } else if (SvPADTMP(sv)) sv = newSVsv(sv); else { diff --git a/pp_ctl.c b/pp_ctl.c index c9afbb6..caaaf20 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1972,7 +1972,6 @@ PP(pp_goto) SV** mark; I32 items = 0; I32 oldsave; - int arg_was_real = 0; retry: if (!CvROOT(cv) && !CvXSUB(cv)) { @@ -2004,8 +2003,8 @@ PP(pp_goto) if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) DIE(aTHX_ "Can't goto subroutine from an eval-string"); mark = PL_stack_sp; - if (CxTYPE(cx) == CXt_SUB && - cx->blk_sub.hasargs) { /* put @_ back onto stack */ + if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) { + /* put @_ back onto stack */ AV* av = cx->blk_sub.argarray; items = AvFILLp(av) + 1; @@ -2017,11 +2016,14 @@ PP(pp_goto) SvREFCNT_dec(GvAV(PL_defgv)); GvAV(PL_defgv) = cx->blk_sub.savearray; #endif /* USE_THREADS */ + /* abandon @_ if it got reified */ if (AvREAL(av)) { - arg_was_real = 1; - AvREAL_off(av); /* so av_clear() won't clobber elts */ + (void)sv_2mortal((SV*)av); /* delay until return */ + av = newAV(); + av_extend(av, items-1); + AvFLAGS(av) = AVf_REIFY; + PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av); } - av_clear(av); } else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ AV* av; @@ -2179,11 +2181,7 @@ PP(pp_goto) } Copy(mark,AvARRAY(av),items,SV*); AvFILLp(av) = items - 1; - /* preserve @_ nature */ - if (arg_was_real) { - AvREIFY_off(av); - AvREAL_on(av); - } + assert(!AvREAL(av)); while (items--) { if (*mark) SvTEMP_off(*mark); diff --git a/pp_hot.c b/pp_hot.c index e75ec30..df5e062 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2522,11 +2522,7 @@ try_autoload: "%p entersub preparing @_\n", thr)); #endif av = (AV*)PL_curpad[0]; - if (AvREAL(av)) { - av_clear(av); - AvREAL_off(av); - AvREIFY_on(av); - } + assert(!AvREAL(av)); #ifndef USE_THREADS cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); diff --git a/t/op/args.t b/t/op/args.t new file mode 100755 index 0000000..48bf5af --- /dev/null +++ b/t/op/args.t @@ -0,0 +1,54 @@ +#!./perl + +print "1..8\n"; + +# test various operations on @_ + +my $ord = 0; +sub new1 { bless \@_ } +{ + my $x = new1("x"); + my $y = new1("y"); + ++$ord; + print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y"; + print "ok $ord\n"; + ++$ord; + print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x"; + print "ok $ord\n"; +} + +sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ } +{ + my $x = new2("x"); + my $y = new2("y"); + ++$ord; + print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x"; + print "ok $ord\n"; + ++$ord; + print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y"; + print "ok $ord\n"; +} + +sub new3 { goto &new1 } +{ + my $x = new3("x"); + my $y = new3("y"); + ++$ord; + print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y"; + print "ok $ord\n"; + ++$ord; + print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x"; + print "ok $ord\n"; +} + +sub new4 { goto &new2 } +{ + my $x = new4("x"); + my $y = new4("y"); + ++$ord; + print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x"; + print "ok $ord\n"; + ++$ord; + print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y"; + print "ok $ord\n"; +}