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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;