add Perl_magic_methcall

Add a new function that wraps the setup needed to call a magic method like
FETCH (the existing S_magic_methcall function has been renamed
S_magic_methcall1).

There is one functional change, done mainly to allow for a single clean
wrapper function, and that is that the method calls are no longer wrapped
with SAVETMPS/FREETMPS. Previously only about half of them had this, so
some relied on the caller to free, some didn't. At least we're consistent
now. Doing it this way is necessary because otherwise magic_methcall()
can't return an SV (eg for POP) because it'll be a temp and get freed by
FREETMPS before it gets returned. So you'd have to copy everything, which
would slow things down.

1 files changed, 16 insertions, 76 deletions

diff --git a/av.c b/av.c
index 94b5f2c559..a3dc4ddf73 100644
--- a/av.c
+++ b/av.c
@@ -74,19 +74,9 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 
     mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
     if (mg) {
-	dSP;
-	ENTER;
-	SAVETMPS;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	mPUSHi(key + 1);
-        PUTBACK;
-	call_method("EXTEND", G_SCALAR|G_DISCARD);
-	POPSTACK;
-	FREETMPS;
-	LEAVE;
+	SV *arg1 = sv_newmortal();
+	sv_setiv(arg1, (IV)(key + 1));
+	magic_methcall(MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1, arg1, NULL);
 	return;
     }
     if (key > AvMAX(av)) {
@@ -554,17 +544,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
 	Perl_croak(aTHX_ "%s", PL_no_modify);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	PUSHs(val);
-	PUTBACK;
-	ENTER;
-	call_method("PUSH", G_SCALAR|G_DISCARD);
-	LEAVE;
-	POPSTACK;
+	magic_methcall(MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1, val, NULL);
 	return;
     }
     av_store(av,AvFILLp(av)+1,val);
@@ -592,19 +572,9 @@ Perl_av_pop(pTHX_ register AV *av)
     if (SvREADONLY(av))
 	Perl_croak(aTHX_ "%s", PL_no_modify);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;    
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	PUTBACK;
-	ENTER;
-	if (call_method("POP", G_SCALAR)) {
-	    retval = newSVsv(*PL_stack_sp--);    
-	} else {    
-	    retval = &PL_sv_undef;
-	}
-	LEAVE;
-	POPSTACK;
+	retval = magic_methcall(MUTABLE_SV(av), mg, "POP", 0, 0, NULL, NULL);
+	if (retval)
+	    retval = newSVsv(retval);
 	return retval;
     }
     if (AvFILL(av) < 0)
@@ -662,19 +632,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 	Perl_croak(aTHX_ "%s", PL_no_modify);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,1+num);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	while (num-- > 0) {
-	    PUSHs(&PL_sv_undef);
-	}
-	PUTBACK;
-	ENTER;
-	call_method("UNSHIFT", G_SCALAR|G_DISCARD);
-	LEAVE;
-	POPSTACK;
+	magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD,
+	    -num, NULL, NULL);
 	return;
     }
 
@@ -734,19 +693,9 @@ Perl_av_shift(pTHX_ register AV *av)
     if (SvREADONLY(av))
 	Perl_croak(aTHX_ "%s", PL_no_modify);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	PUTBACK;
-	ENTER;
-	if (call_method("SHIFT", G_SCALAR)) {
-	    retval = newSVsv(*PL_stack_sp--);            
-	} else {    
-	    retval = &PL_sv_undef;
-	}     
-	LEAVE;
-	POPSTACK;
+	retval = magic_methcall(MUTABLE_SV(av), mg, "SHIFT", 0, 0, NULL, NULL);
+	if (retval)
+	    retval = newSVsv(retval);
 	return retval;
     }
     if (AvFILL(av) < 0)
@@ -806,19 +755,10 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     if (fill < 0)
 	fill = -1;
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-	dSP;            
-	ENTER;
-	SAVETMPS;
-	PUSHSTACKi(PERLSI_MAGIC);
-	PUSHMARK(SP);
-	EXTEND(SP,2);
-	PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-	mPUSHi(fill + 1);
-	PUTBACK;
-	call_method("STORESIZE", G_SCALAR|G_DISCARD);
-	POPSTACK;
-	FREETMPS;
-	LEAVE;
+	SV *arg1 = sv_newmortal();
+	sv_setiv(arg1, (IV)(fill + 1));
+	magic_methcall(MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+		1, arg1, NULL);
 	return;
     }
     if (fill <= AvMAX(av)) {