Merge changes as of 18:00 CST

p4raw-id: //depot/ansiperl@211

1 files changed, 34 insertions, 3 deletions

diff --git a/pp_sys.c b/pp_sys.c
index 34a175ae03..39cc4e26ba 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -509,12 +509,14 @@ PP(pp_tie)
     SV *varsv;
     HV* stash;
     GV *gv;
-    BINOP myop;
     SV *sv;
     SV **mark = stack_base + ++*markstack_ptr;	/* reuse in entersub */
     I32 markoff = mark - stack_base - 1;
     char *methname;
+#ifdef ORIGINAL_TIE
+    BINOP myop;
     bool oldcatch = CATCH_GET;
+#endif
 
     varsv = mark[0];
     if (SvTYPE(varsv) == SVt_PVHV)
@@ -531,6 +533,7 @@ PP(pp_tie)
 	DIE("Can't locate object method \"%s\" via package \"%s\"",
 		methname, SvPV(mark[1],na));
 
+#ifdef ORIGINAL_TIE
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
@@ -551,6 +554,11 @@ PP(pp_tie)
     SPAGAIN;
 
     CATCH_SET(oldcatch);
+#else
+    ENTER;
+    perl_call_sv((SV*)gv, G_SCALAR);
+    SPAGAIN;
+#endif	
     sv = TOPs;
     if (sv_isobject(sv)) {
 	if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
@@ -625,9 +633,11 @@ PP(pp_dbmopen)
     dPOPPOPssrl;
     HV* stash;
     GV *gv;
-    BINOP myop;
     SV *sv;
+#ifdef ORIGINAL_TIE
+    BINOP myop;
     bool oldcatch = CATCH_GET;
+#endif	
 
     hv = (HV*)POPs;
 
@@ -642,6 +652,7 @@ PP(pp_dbmopen)
 	    DIE("No dbm on this machine");
     }
 
+#ifdef ORIGINAL_TIE
     Zero(&myop, 1, BINOP);
     myop.op_last = (OP *) &myop;
     myop.op_next = Nullop;
@@ -655,7 +666,10 @@ PP(pp_dbmopen)
 	op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
     pp_pushmark(ARGS);
-
+#else
+    ENTER;
+    PUSHMARK(sp);
+#endif	
     EXTEND(sp, 5);
     PUSHs(sv);
     PUSHs(left);
@@ -664,32 +678,49 @@ PP(pp_dbmopen)
     else
 	PUSHs(sv_2mortal(newSViv(O_RDWR)));
     PUSHs(right);
+#ifdef ORIGINAL_TIE
     PUSHs((SV*)GvCV(gv));
     PUTBACK;
 
     if (op = pp_entersub(ARGS))
         runops();
+#else
+    PUTBACK;
+    perl_call_sv((SV*)gv, G_SCALAR);
+#endif	
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
 	sp--;
+#ifdef ORIGINAL_TIE
 	op = (OP *) &myop;
 	PUTBACK;
 	pp_pushmark(ARGS);
+#else
+	PUSHMARK(sp);
+#endif	
 
 	PUSHs(sv);
 	PUSHs(left);
 	PUSHs(sv_2mortal(newSViv(O_RDONLY)));
 	PUSHs(right);
+#ifdef ORIGINAL_TIE
 	PUSHs((SV*)GvCV(gv));
+#endif	
 	PUTBACK;
 
+#ifdef ORIGINAL_TIE
 	if (op = pp_entersub(ARGS))
 	    runops();
+#else
+	perl_call_sv((SV*)gv, G_SCALAR);
+#endif	
 	SPAGAIN;
     }
 
+#ifdef ORIGINAL_TIE
     CATCH_SET(oldcatch);
+#endif	
     if (sv_isobject(TOPs))
 	sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
     LEAVE;