From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 13 Jun 2010 08:34:56 +0000 (+0200)
Subject: Merge simple tied handle method calls into S_tied_handle_method().
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ebc1fde647268c1d49a6096baf6ca8a708363f5b;p=p5sagit%2Fp5-mst-13.2.git

Merge simple tied handle method calls into S_tied_handle_method().
---

diff --git a/embed.fnc b/embed.fnc
index 36d8c1a..1a118b1 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1716,6 +1716,8 @@ s	|OP*	|doform		|NN CV *cv|NN GV *gv|NN OP *retop
 sR	|int	|dooneliner	|NN const char *cmd|NN const char *filename
 #  endif
 s	|SV *	|space_join_names_mortal|NN char *const *array
+s	|OP *	|tied_handle_method|NN const char *const methname|NN SV **sp \
+				|NN IO *const io|NN MAGIC *const mg
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index 80457a2..4fe29c4 100644
--- a/embed.h
+++ b/embed.h
@@ -1455,6 +1455,7 @@
 #  endif
 #ifdef PERL_CORE
 #define space_join_names_mortal	S_space_join_names_mortal
+#define tied_handle_method	S_tied_handle_method
 #endif
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
@@ -3895,6 +3896,7 @@
 #  endif
 #ifdef PERL_CORE
 #define space_join_names_mortal(a)	S_space_join_names_mortal(aTHX_ a)
+#define tied_handle_method(a,b,c,d)	S_tied_handle_method(aTHX_ a,b,c,d)
 #endif
 #endif
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
diff --git a/pp_sys.c b/pp_sys.c
index a39453b..0fe80b4 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -552,6 +552,21 @@ PP(pp_open)
     RETURN;
 }
 
+static OP *
+S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
+		     IO *const io, MAGIC *const mg)
+{
+    PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
+
+    PUSHMARK(sp);
+    PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
+    PUTBACK;
+    ENTER_with_name("call_tied_handle_method");
+    call_method(methname, G_SCALAR);
+    LEAVE_with_name("call_tied_handle_method");
+    return NORMAL;
+}
+
 PP(pp_close)
 {
     dVAR; dSP;
@@ -565,14 +580,7 @@ PP(pp_close)
 	if (io) {
 	    MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
 	    if (mg) {
-		PUSHMARK(SP);
-		PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-		PUTBACK;
-		ENTER_with_name("call_CLOSE");
-		call_method("CLOSE", G_SCALAR);
-		LEAVE_with_name("call_CLOSE");
-		SPAGAIN;
-		RETURN;
+		return tied_handle_method("CLOSE", SP, io, mg);
 	    }
 	}
     }
@@ -655,14 +663,7 @@ PP(pp_fileno)
     if (gv && (io = GvIO(gv))
 	&& (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {
-	PUSHMARK(SP);
-	PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-	PUTBACK;
-	ENTER_with_name("call_FILENO");
-	call_method("FILENO", G_SCALAR);
-	LEAVE_with_name("call_FILENO");
-	SPAGAIN;
-	RETURN;
+	return tied_handle_method("FILENO", SP, io, mg);
     }
 
     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
@@ -2084,14 +2085,7 @@ PP(pp_tell)
     if (gv && (io = GvIO(gv))) {
 	MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
 	if (mg) {
-	    PUSHMARK(SP);
-	    PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-	    PUTBACK;
-	    ENTER;
-	    call_method("TELL", G_SCALAR);
-	    LEAVE;
-	    SPAGAIN;
-	    RETURN;
+	    return tied_handle_method("TELL", SP, io, mg);
 	}
     }
     else if (!gv) {
diff --git a/proto.h b/proto.h
index 271107f..2721fac 100644
--- a/proto.h
+++ b/proto.h
@@ -5350,6 +5350,14 @@ 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)
+			__attribute__nonnull__(pTHX_1)
+			__attribute__nonnull__(pTHX_2)
+			__attribute__nonnull__(pTHX_3)
+			__attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT_TIED_HANDLE_METHOD	\
+	assert(methname); assert(sp); assert(io); assert(mg)
+
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)