From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 13 Jun 2010 13:02:14 +0000 (+0200)
Subject: In S_tied_handle_method() default to mortalizing extra arguments.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=74f0b5509afd269c59f1396fde551295bbeec7d5;p=p5sagit%2Fp5-mst-13.2.git

In S_tied_handle_method() default to mortalizing extra arguments.

Convert the gimme argument to a flags argument, and add a flag bit to signal
that mortalization is not required. Only "BINMODE" needs this.
---

diff --git a/embed.fnc b/embed.fnc
index 582e860..d22f2f6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1718,7 +1718,7 @@ sR	|int	|dooneliner	|NN const char *cmd|NN const char *filename
 s	|SV *	|space_join_names_mortal|NN char *const *array
 so	|OP *	|tied_handle_method|NN const char *const methname|NN SV **sp \
 				|NN IO *const io|NN MAGIC *const mg \
-				|const U32 gimme|unsigned int argc|...
+				|const U32 flags|unsigned int argc|...
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
diff --git a/pp_sys.c b/pp_sys.c
index f9112ff..94ac3a4 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -552,28 +552,39 @@ PP(pp_open)
     RETURN;
 }
 
+/* This is private to this function, which is private to this file.
+   Use 0x04 rather than the next available bit, to help the compiler if the
+   architecture can generate more efficient instructions.  */
+#define MORTALIZE_NOT_NEEDED	0x04
+
 static OP *
 S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
-		     IO *const io, MAGIC *const mg, const U32 gimme,
+		     IO *const io, MAGIC *const mg, const U32 flags,
 		     unsigned int argc, ...)
 {
     PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
 
+    assert((MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+
     PUSHMARK(sp);
     PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
     if (argc) {
+	const U32 mortalize_not_needed = flags & MORTALIZE_NOT_NEEDED;
 	va_list args;
 	va_start(args, argc);
 	do {
 	    SV *const arg = va_arg(args, SV *);
-	    PUSHs(arg);
+	    if(mortalize_not_needed)
+		PUSHs(arg);
+	    else
+		mPUSHs(arg);
 	} while (--argc);
 	va_end(args);
     }
 
     PUTBACK;
     ENTER_with_name("call_tied_handle_method");
-    call_method(methname, gimme);
+    call_method(methname, flags & G_WANT);
     LEAVE_with_name("call_tied_handle_method");
     return NORMAL;
 }
@@ -751,7 +762,8 @@ PP(pp_binmode)
 	       function, which I don't think that the optimiser will be able to
 	       figure out. Although, as it's a static function, in theory it
 	       could.  */
-	    return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg, G_SCALAR,
+	    return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
+					G_SCALAR|MORTALIZE_NOT_NEEDED,
 					discp ? 1 : 0, discp);
 	}
     }
@@ -2053,8 +2065,7 @@ PP(pp_eof)
 	RETPUSHNO;
 
     if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
-	return tied_handle_method1("EOF", SP, io, mg,
-				   sv_2mortal(newSVuv(which)));
+	return tied_handle_method1("EOF", SP, io, mg, newSVuv(which));
     }
 
     if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {	/* eof() */
@@ -2128,13 +2139,13 @@ PP(pp_sysseek)
 	MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
 	if (mg) {
 #if LSEEKSIZE > IVSIZE
-	    SV *const offset_sv = sv_2mortal(newSVnv((NV) offset));
+	    SV *const offset_sv = newSVnv((NV) offset);
 #else
-	    SV *const offset_sv = sv_2mortal(newSViv(offset));
+	    SV *const offset_sv = newSViv(offset);
 #endif
 
 	    return tied_handle_method2("SEEK", SP, io, mg, offset_sv,
-				       sv_2mortal(newSViv(whence)));
+				       newSViv(whence));
 	}
     }
 
diff --git a/proto.h b/proto.h
index 3ab407e..7e3bcfb 100644
--- a/proto.h
+++ b/proto.h
@@ -5350,7 +5350,7 @@ STATIC SV *	S_space_join_names_mortal(pTHX_ char *const *array)
 #define PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL	\
 	assert(array)
 
-STATIC OP *	S_tied_handle_method(pTHX_ const char *const methname, SV **sp, IO *const io, MAGIC *const mg, const U32 gimme, unsigned int argc, ...)
+STATIC OP *	S_tied_handle_method(pTHX_ const char *const methname, SV **sp, IO *const io, MAGIC *const mg, const U32 flags, unsigned int argc, ...)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_3)