The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Index: cop.h
===================================================================
RCS file: /local/perl/build/CVSROOT/perl/cop.h,v
retrieving revision 1.1.1.1
diff -u -p -u -p -r1.1.1.1 cop.h
--- cop.h	2000/05/22 14:58:14	1.1.1.1
+++ cop.h	2000/05/22 19:01:04
@@ -423,6 +423,7 @@ L<perlcall>.
 #define G_NOARGS	8	/* Don't construct a @_ array. */
 #define G_KEEPERR      16	/* Append errors to $@, don't overwrite it */
 #define G_NODEBUG      32	/* Disable debugging at toplevel.  */
+#define G_METHOD       64       /* Calling method */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL	0	/* not in an eval */
Index: perl.c
===================================================================
RCS file: /local/perl/build/CVSROOT/perl/perl.c,v
retrieving revision 1.1.1.1
diff -u -p -u -p -r1.1.1.1 perl.c
--- perl.c	2000/05/22 14:58:14	1.1.1.1
+++ perl.c	2000/05/22 20:01:00
@@ -1565,18 +1565,7 @@ Perl_call_method(pTHX_ const char *methn
                		/* name of the subroutine */
           		/* See G_* flags in cop.h */
 {
-    dSP;
-    OP myop;
-    if (!PL_op) {
-	Zero(&myop, 1, OP);
-	PL_op = &myop;
-    }
-    XPUSHs(sv_2mortal(newSVpv(methname,0)));
-    PUTBACK;
-    pp_method();
-    if (PL_op == &myop)
-	PL_op = Nullop;
-    return call_sv(*PL_stack_sp--, flags);
+    return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
 }
 
 /* May be called with any of a CV, a GV, or an SV containing the name. */
@@ -1596,6 +1585,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 {
     dSP;
     LOGOP myop;		/* fake syntax tree node */
+    OP method_op;
     I32 oldmark;
     I32 retval;
     I32 oldscope;
@@ -1633,6 +1623,14 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	  && !(flags & G_NODEBUG))
 	PL_op->op_private |= OPpENTERSUB_DB;
 
+    if (flags & G_METHOD) {
+	Zero(&method_op, 1, OP);
+	method_op.op_next = PL_op;
+	method_op.op_ppaddr = pp_method;
+	myop.op_ppaddr = pp_entersub;
+	PL_op = &method_op;
+    }
+
     if (!(flags & G_EVAL)) {
 	CATCH_SET(TRUE);
 	call_body((OP*)&myop, FALSE);
@@ -1650,7 +1648,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    ENTER;
 	    SAVETMPS;
 	    
-	    push_return(PL_op->op_next);
+	    push_return(Nullop);
 	    PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
 	    PUSHEVAL(cx, 0, 0);
 	    PL_eval_root = PL_op;             /* Only needed so that goto works right. */