From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Fri, 7 Nov 1997 18:12:36 +0000 (+0000)
Subject: Change pp_tie and pp_dbmopen to use perl_call_sv instead of a
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=57d3b86dc9b74a9b2d9e24c40494104c74f62be7;p=p5sagit%2Fp5-mst-13.2.git

Change pp_tie and pp_dbmopen to use perl_call_sv instead of a
DIY pp_entersub (in preparation for AUTOLOAD change). dbmopen
not tested. ofslen now maps to thr->Tofslen in thread.h. Added
missing #ifdef USE_THREADS around some DEBU_L statements in die().
Building without USE_THREADS fails quite a lot of tests. It looks
as though the move to per-thread magicals must be missing some
#ifdef USE_THREADS.

p4raw-id: //depot/perl@209
---

diff --git a/op.c b/op.c
index e91bea9..3bd44fc 100644
--- a/op.c
+++ b/op.c
@@ -3615,7 +3615,7 @@ OP *block;
     return cv;
 }
 
-V *
+CV *
 newXS(name, subaddr, filename)
 char *name;
 void (*subaddr) _((CV*));
diff --git a/pp.c b/pp.c
index 866ddb0..c2585ae 100644
--- a/pp.c
+++ b/pp.c
@@ -4298,8 +4298,8 @@ PP(pp_lock)
 
 PP(pp_specific)
 {
-#ifdef USE_THREADS
     dSP;
+#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 3f339e9..5eaa1e1 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -503,12 +503,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)
@@ -525,6 +527,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;
@@ -545,6 +548,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) {
@@ -619,9 +627,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;
 
@@ -636,6 +646,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;
@@ -649,7 +660,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);
@@ -658,32 +672,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/thread.h b/thread.h
index b496d69..305155c 100644
--- a/thread.h
+++ b/thread.h
@@ -358,6 +358,7 @@ typedef struct condpair {
 #define	rs		(thr->Trs)
 #define	last_in_gv	(thr->Tlast_in_gv)
 #define	ofs		(thr->Tofs)
+#define	ofslen		(thr->Tofslen)
 #define	defoutgv	(thr->Tdefoutgv)
 #define	chopset		(thr->Tchopset)
 #define	formtarget	(thr->Tformtarget)
diff --git a/util.c b/util.c
index b348066..72c76a0 100644
--- a/util.c
+++ b/util.c
@@ -1176,9 +1176,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 */
@@ -1195,9 +1197,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;
@@ -1225,9 +1229,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;