Merge changes as of 18:00 CST

p4raw-id: //depot/ansiperl@211

4 files changed, 41 insertions, 5 deletions

diff --git a/op.c b/op.c
index 2f79a6f924..1c866f79d7 100644
--- a/op.c
+++ b/op.c
@@ -3466,7 +3466,6 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     return cv;
 }
 
-
 CV *
 newXS(char *name, void (*subaddr) (CV *), char *filename)
 {
diff --git a/pp.c b/pp.c
index 3df534008e..143df7cb0b 100644
--- a/pp.c
+++ b/pp.c
@@ -4297,8 +4297,8 @@ PP(pp_lock)
 
 PP(pp_specific)
 {
-#ifdef USE_THREADS
     djSP;
+#ifdef USE_THREADS
     SV **svp = av_fetch(thr->magicals, op->op_targ, FALSE);
     if (!svp)
 	croak("panic: pp_specific");
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;
diff --git a/util.c b/util.c
index 4ece7f1224..914ec6ace5 100644
--- a/util.c
+++ b/util.c
@@ -1126,9 +1126,11 @@ die(pat, va_alist)
     GV *gv;
     CV *cv;
 
+#ifdef USE_THREADS
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 			  "%p: die: curstack = %p, mainstack = %p\n",
 			  thr, curstack, mainstack));
+#endif /* USE_THREADS */
     /* We have to switch back to mainstack or die_where may try to pop
      * the eval block from the wrong stack if die is being called from a
      * signal handler.  - dkindred@cs.cmu.edu */
@@ -1145,9 +1147,11 @@ die(pat, va_alist)
     message = mess(pat, &args);
     va_end(args);
 
+#ifdef USE_THREADS
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 			  "%p: die: message = %s\ndiehook = %p\n",
 			  thr, message, diehook));
+#endif /* USE_THREADS */
     if (diehook) {
 	/* sv_2cv might call croak() */
 	SV *olddiehook = diehook;
@@ -1175,9 +1179,11 @@ die(pat, va_alist)
     }
 
     restartop = die_where(message);
+#ifdef USE_THREADS
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 	  "%p: die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n",
 	  thr, restartop, was_in_eval, oldrunlevel));
+#endif /* USE_THREADS */
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
 	JMPENV_JUMP(3);
     return restartop;