-----------------------------------8<-----------------------------------
Change 4195 by gsar@auger on 1999/09/19 21:30:18

	avoid clearing @_ at all for faster subroutine calls; fix bugs
	in passing around references to @_, eg C<sub foo { \@_ }>; add
	tests for the same

Affected files ...

... //depot/perl/MANIFEST#193 edit
... //depot/perl/cop.h#29 edit
... //depot/perl/pp.c#144 edit
... //depot/perl/pp_ctl.c#147 edit
... //depot/perl/pp_hot.c#131 edit
... //depot/perl/t/op/args.t#1 add

Differences ...

==== //depot/perl/MANIFEST#193 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~	Sun Sep 19 14:30:23 1999
+++ perl/MANIFEST	Sun Sep 19 14:30:23 1999
@@ -1236,6 +1236,7 @@
 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

==== //depot/perl/cop.h#29 (text) ====
Index: perl/cop.h
--- perl/cop.h.~1~	Sun Sep 19 14:30:23 1999
+++ perl/cop.h	Sun Sep 19 14:30:23 1999
@@ -66,17 +66,22 @@
 #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))			\

==== //depot/perl/pp.c#144 (text) ====
Index: perl/pp.c
--- perl/pp.c.~1~	Sun Sep 19 14:30:23 1999
+++ perl/pp.c	Sun Sep 19 14:30:23 1999
@@ -530,6 +530,12 @@
 	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 {

==== //depot/perl/pp_ctl.c#147 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c.~1~	Sun Sep 19 14:30:23 1999
+++ perl/pp_ctl.c	Sun Sep 19 14:30:23 1999
@@ -1972,7 +1972,6 @@
 	    SV** mark;
 	    I32 items = 0;
 	    I32 oldsave;
-	    int arg_was_real = 0;
 
 	retry:
 	    if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -2004,8 +2003,8 @@
 	    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 @@
 		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 @@
 		    }
 		    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);

==== //depot/perl/pp_hot.c#131 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c.~1~	Sun Sep 19 14:30:23 1999
+++ perl/pp_hot.c	Sun Sep 19 14:30:23 1999
@@ -2522,11 +2522,7 @@
 	    			  "%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);

==== //depot/perl/t/op/args.t#1 (xtext) ====
Index: perl/t/op/args.t
--- perl/t/op/args.t.~1~	Sun Sep 19 14:30:23 1999
+++ perl/t/op/args.t	Sun Sep 19 14:30:23 1999
@@ -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";
+}
End of Patch.