add patch for C<use re 'debug'>
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 60e8825..464e20d 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -42,8 +42,6 @@ static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
 static OP *doeval _((int gimme, OP** startop));
 #endif
 
-static I32 sortcxix;
-
 PP(pp_wantarray)
 {
     djSP;
@@ -69,7 +67,8 @@ PP(pp_regcmaybe)
     return NORMAL;
 }
 
-PP(pp_regcomp) {
+PP(pp_regcomp)
+{
     djSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     register char *t;
@@ -78,12 +77,12 @@ PP(pp_regcomp) {
     MAGIC *mg = Null(MAGIC*);
 
     tmpstr = POPs;
-    if(SvROK(tmpstr)) {
+    if (SvROK(tmpstr)) {
        SV *sv = SvRV(tmpstr);
        if(SvMAGICAL(sv))
            mg = mg_find(sv, 'r');
     }
-    if(mg) {
+    if (mg) {
        regexp *re = (regexp *)mg->mg_obj;
        ReREFCNT_dec(pm->op_pmregexp);
        pm->op_pmregexp = ReREFCNT_inc(re);
@@ -91,20 +90,30 @@ PP(pp_regcomp) {
     else {
        t = SvPV(tmpstr, len);
 
-       /* JMR: Check against the last compiled regexp */
-       if ( ! pm->op_pmregexp  || ! pm->op_pmregexp->precomp
-           || strnNE(pm->op_pmregexp->precomp, t, len) 
-           || pm->op_pmregexp->precomp[len]) {
+       /* Check against the last compiled regexp. */
+       if (!pm->op_pmregexp || !pm->op_pmregexp->precomp ||
+           pm->op_pmregexp->prelen != len ||
+           memNE(pm->op_pmregexp->precomp, t, len))
+       {
            if (pm->op_pmregexp) {
                ReREFCNT_dec(pm->op_pmregexp);
                pm->op_pmregexp = Null(REGEXP*);        /* crucial if regcomp aborts */
            }
 
            pm->op_pmflags = pm->op_pmpermflags;        /* reset case sensitivity */
-           pm->op_pmregexp = pregcomp(t, t + len, pm);
+           pm->op_pmregexp = (*regcompp)(t, t + len, pm);
        }
     }
 
+#ifndef INCOMPLETE_TAINTS
+    if (tainting) {
+       if (tainted)
+           pm->op_pmdynflags |= PMdf_TAINTED;
+       else
+           pm->op_pmdynflags &= ~PMdf_TAINTED;
+    }
+#endif
+
     if (!pm->op_pmregexp->prelen && curpm)
        pm = curpm;
     else if (strEQ("\\s+", pm->op_pmregexp->precomp))
@@ -134,19 +143,19 @@ PP(pp_substcont)
        if (cx->sb_iters > cx->sb_maxiters)
            DIE("Substitution loop");
 
-       if (!cx->sb_rxtainted)
-           cx->sb_rxtainted = SvTAINTED(TOPs);
+       if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
+           cx->sb_rxtainted |= 2;
        sv_catsv(dstr, POPs);
 
        /* Are we done */
-       if (cx->sb_once || !regexec_flags(rx, s, cx->sb_strend, orig,
+       if (cx->sb_once || !(*regexecp)(rx, s, cx->sb_strend, orig,
                                     s == m, Nullsv, NULL,
                                     cx->sb_safebase ? 0 : REXEC_COPY_STR))
        {
            SV *targ = cx->sb_targ;
            sv_catpvn(dstr, s, cx->sb_strend - s);
 
-           TAINT_IF(cx->sb_rxtainted || RX_MATCH_TAINTED(rx));
+           cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
 
            (void)SvOOK_off(targ);
            Safefree(SvPVX(targ));
@@ -155,11 +164,15 @@ PP(pp_substcont)
            SvLEN_set(targ, SvLEN(dstr));
            SvPVX(dstr) = 0;
            sv_free(dstr);
+
+           TAINT_IF(cx->sb_rxtainted & 1);
+           PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
+
            (void)SvPOK_only(targ);
+           TAINT_IF(cx->sb_rxtainted);
            SvSETMAGIC(targ);
            SvTAINT(targ);
 
-           PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
            LEAVE_SCOPE(cx->sb_oldsave);
            POPSUBST(cx);
            RETURNOP(pm->op_next);
@@ -538,7 +551,7 @@ PP(pp_grepstart)
     djSP;
     SV *src;
 
-    if (stack_base + *markstack_ptr == sp) {
+    if (stack_base + *markstack_ptr == SP) {
        (void)POPMARK;
        if (GIMME_V == G_SCALAR)
            XPUSHs(&sv_no);
@@ -552,7 +565,7 @@ PP(pp_grepstart)
     SAVETMPS;
 #ifdef USE_THREADS
     /* SAVE_DEFSV does *not* suffice here */
-    save_sptr(av_fetch(thr->threadsv, find_threadsv("_"), FALSE));
+    save_sptr(&THREADSV(0));
 #else
     SAVESPTR(GvSV(defgv));
 #endif /* USE_THREADS */
@@ -577,7 +590,7 @@ PP(pp_mapstart)
 PP(pp_mapwhile)
 {
     djSP;
-    I32 diff = (sp - stack_base) - *markstack_ptr;
+    I32 diff = (SP - stack_base) - *markstack_ptr;
     I32 count;
     I32 shift;
     SV** src;
@@ -587,11 +600,11 @@ PP(pp_mapwhile)
     if (diff) {
        if (diff > markstack_ptr[-1] - markstack_ptr[-2]) {
            shift = diff - (markstack_ptr[-1] - markstack_ptr[-2]);
-           count = (sp - stack_base) - markstack_ptr[-1] + 2;
+           count = (SP - stack_base) - markstack_ptr[-1] + 2;
            
-           EXTEND(sp,shift);
-           src = sp;
-           dst = (sp += shift);
+           EXTEND(SP,shift);
+           src = SP;
+           dst = (SP += shift);
            markstack_ptr[-1] += shift;
            *markstack_ptr += shift;
            while (--count)
@@ -637,15 +650,6 @@ PP(pp_mapwhile)
     }
 }
 
-
-#ifdef PERL_OBJECT
-static CPerlObj *pSortPerl;
-static int SortCv(const void *a, const void *b)
-{
-    return pSortPerl->sortcv(a, b);
-}
-#endif
-
 PP(pp_sort)
 {
     djSP; dMARK; dORIGMARK;
@@ -663,8 +667,9 @@ PP(pp_sort)
        RETPUSHUNDEF;
     }
 
+    ENTER;
+    SAVEPPTR(sortcop);
     if (op->op_flags & OPf_STACKED) {
-       ENTER;
        if (op->op_flags & OPf_SPECIAL) {
            OP *kid = cLISTOP->op_first->op_sibling;    /* pass pushmark */
            kid = kUNOP->op_first;                      /* pass rv2gv */
@@ -716,7 +721,6 @@ PP(pp_sort)
     max = --up - myorigmark;
     if (sortcop) {
        if (max > 1) {
-           AV *oldstack;
            PERL_CONTEXT *cx;
            SV** newsp;
            bool oldcatch = CATCH_GET;
@@ -724,14 +728,8 @@ PP(pp_sort)
            SAVETMPS;
            SAVEOP();
 
-           oldstack = curstack;
-           if (!sortstack) {
-               sortstack = newAV();
-               AvREAL_off(sortstack);
-               av_extend(sortstack, 32);
-           }
            CATCH_SET(TRUE);
-           SWITCHSTACK(curstack, sortstack);
+           PUSHSTACKi(PERLSI_SORT);
            if (sortstash != stash) {
                firstgv = gv_fetchpv("a", TRUE, SVt_PV);
                secondgv = gv_fetchpv("b", TRUE, SVt_PV);
@@ -751,39 +749,23 @@ PP(pp_sort)
                    (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
            }
            sortcxix = cxstack_ix;
-
-#ifdef PERL_OBJECT
-           MUTEX_LOCK(&sort_mutex);
-           pSortPerl = this;
-           qsortsv((myorigmark+1), max, SortCv);
-           MUTEX_UNLOCK(&sort_mutex);
-#else
-           qsortsv((myorigmark+1), max, sortcv);
-#endif
+           qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
 
            POPBLOCK(cx,curpm);
-           SWITCHSTACK(sortstack, oldstack);
+           POPSTACK;
            CATCH_SET(oldcatch);
        }
-       LEAVE;
     }
     else {
        if (max > 1) {
            MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
-#ifdef PERL_OBJECT
-           /* XXX sort_mutex is probably not needed since qsort is now
-            * internal GSAR */
-           MUTEX_LOCK(&sort_mutex);
-           pSortPerl = this;
-           qsortsv(ORIGMARK+1, max,
-                 (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp);
-           MUTEX_UNLOCK(&sort_mutex);
-#else
            qsortsv(ORIGMARK+1, max,
-                 (op->op_private & OPpLOCALE) ? sv_cmp_locale : sv_cmp);
-#endif
+                   (op->op_private & OPpLOCALE)
+                   ? FUNC_NAME_TO_PTR(sv_cmp_locale)
+                   : FUNC_NAME_TO_PTR(sv_cmp));
        }
     }
+    LEAVE;
     stack_sp = ORIGMARK + max;
     return nextop;
 }
@@ -819,7 +801,7 @@ PP(pp_flip)
            }
            else {
                sv_setiv(targ, 0);
-               sp--;
+               SP--;
                RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
            }
        }
@@ -842,6 +824,8 @@ PP(pp_flop)
        if (SvNIOKp(left) || !SvPOKp(left) ||
          (looks_like_number(left) && *SvPVX(left) != '0') )
        {
+           if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
+               croak("Range iterator outside integer range");
            i = SvIV(left);
            max = SvIV(right);
            if (max >= i) {
@@ -859,14 +843,13 @@ PP(pp_flop)
            char *tmps = SvPV(final, len);
 
            sv = sv_mortalcopy(left);
-           while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
-               strNE(SvPVX(sv),tmps) ) {
+           while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
                XPUSHs(sv);
+               if (strEQ(SvPVX(sv),tmps))
+                   break;
                sv = sv_2mortal(newSVsv(sv));
                sv_inc(sv);
            }
-           if (strEQ(SvPVX(sv),tmps))
-               XPUSHs(sv);
        }
     }
     else {
@@ -945,14 +928,16 @@ block_gimme(void)
        return G_VOID;
 
     switch (cxstack[cxix].blk_gimme) {
+    case G_VOID:
+       return G_VOID;
     case G_SCALAR:
        return G_SCALAR;
     case G_ARRAY:
        return G_ARRAY;
     default:
        croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme);
-    case G_VOID:
-       return G_VOID;
+       /* NOTREACHED */
+       return 0;
     }
 }
 
@@ -1039,7 +1024,7 @@ dounwind(I32 cxix)
     while (cxstack_ix > cxix) {
        cx = &cxstack[cxstack_ix];
        DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
-                             (long) cxstack_ix+1, block_type[cx->cx_type]));
+                             (long) cxstack_ix, block_type[cx->cx_type]));
        /* Note: we don't need to restore the base context info till the end. */
        switch (cx->cx_type) {
        case CXt_SUBST:
@@ -1064,37 +1049,45 @@ dounwind(I32 cxix)
 OP *
 die_where(char *message)
 {
-    dTHR;
+    dSP;
     if (in_eval) {
        I32 cxix;
        register PERL_CONTEXT *cx;
        I32 gimme;
        SV **newsp;
 
-       if (in_eval & 4) {
-           SV **svp;
-           STRLEN klen = strlen(message);
-           
-           svp = hv_fetch(ERRHV, message, klen, TRUE);
-           if (svp) {
-               if (!SvIOK(*svp)) {
-                   static char prefix[] = "\t(in cleanup) ";
-                   SV *err = ERRSV;
-                   sv_upgrade(*svp, SVt_IV);
-                   (void)SvIOK_only(*svp);
-                   if (!SvPOK(err))
-                       sv_setpv(err,"");
-                   SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
-                   sv_catpvn(err, prefix, sizeof(prefix)-1);
-                   sv_catpvn(err, message, klen);
+       if (message) {
+           if (in_eval & 4) {
+               SV **svp;
+               STRLEN klen = strlen(message);
+               
+               svp = hv_fetch(ERRHV, message, klen, TRUE);
+               if (svp) {
+                   if (!SvIOK(*svp)) {
+                       static char prefix[] = "\t(in cleanup) ";
+                       SV *err = ERRSV;
+                       sv_upgrade(*svp, SVt_IV);
+                       (void)SvIOK_only(*svp);
+                       if (!SvPOK(err))
+                           sv_setpv(err,"");
+                       SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
+                       sv_catpvn(err, prefix, sizeof(prefix)-1);
+                       sv_catpvn(err, message, klen);
+                   }
+                   sv_inc(*svp);
                }
-               sv_inc(*svp);
            }
+           else
+               sv_setpv(ERRSV, message);
        }
        else
-           sv_setpv(ERRSV, message);
-       
-       cxix = dopoptoeval(cxstack_ix);
+           message = SvPVx(ERRSV, na);
+
+       while ((cxix = dopoptoeval(cxstack_ix)) < 0 && curstackinfo->si_prev) {
+           dounwind(-1);
+           POPSTACK;
+       }
+
        if (cxix >= 0) {
            I32 optype;
 
@@ -1162,6 +1155,7 @@ PP(pp_caller)
     register PERL_CONTEXT *cx;
     I32 dbcxix;
     I32 gimme;
+    HV *hv;
     SV *sv;
     I32 count = 0;
 
@@ -1191,14 +1185,22 @@ PP(pp_caller)
     }
 
     if (GIMME != G_ARRAY) {
-       dTARGET;
-
-       sv_setpv(TARG, HvNAME(cx->blk_oldcop->cop_stash));
-       PUSHs(TARG);
+       hv = cx->blk_oldcop->cop_stash;
+       if (!hv)
+           PUSHs(&sv_undef);
+       else {
+           dTARGET;
+           sv_setpv(TARG, HvNAME(hv));
+           PUSHs(TARG);
+       }
        RETURN;
     }
 
-    PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
+    hv = cx->blk_oldcop->cop_stash;
+    if (!hv)
+       PUSHs(&sv_undef);
+    else
+       PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
     PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
@@ -1304,7 +1306,7 @@ PP(pp_dbstate)
 
     if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace))
     {
-       SV **sp;
+       djSP;
        register CV *cv;
        register PERL_CONTEXT *cx;
        I32 gimme = G_ARRAY;
@@ -1326,10 +1328,10 @@ PP(pp_dbstate)
        SAVESTACK_POS();
        debug = 0;
        hasargs = 0;
-       sp = stack_sp;
+       SPAGAIN;
 
        push_return(op->op_next);
-       PUSHBLOCK(cx, CXt_SUB, sp);
+       PUSHBLOCK(cx, CXt_SUB, SP);
        PUSHSUB(cx);
        CvDEPTH(cv)++;
        (void)SvREFCNT_inc(cv);
@@ -1366,19 +1368,35 @@ PP(pp_enteriter)
        SAVESPTR(*svp);
     }
     else {
-       svp = &GvSV((GV*)POPs);                 /* symbol table variable */
-       SAVESPTR(*svp);
+       GV *gv = (GV*)POPs;
+       (void)save_scalar(gv);
+       svp = &GvSV(gv);                        /* symbol table variable */
     }
 
     ENTER;
 
     PUSHBLOCK(cx, CXt_LOOP, SP);
     PUSHLOOP(cx, svp, MARK);
-    if (op->op_flags & OPf_STACKED)
+    if (op->op_flags & OPf_STACKED) {
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
+       if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+           dPOPss;
+           if (SvNIOKp(sv) || !SvPOKp(sv) ||
+               (looks_like_number(sv) && *SvPVX(sv) != '0')) {
+                if (SvNV(sv) < IV_MIN ||
+                    SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
+                    croak("Range iterator outside integer range");
+                cx->blk_loop.iterix = SvIV(sv);
+                cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
+                sv_setiv(*svp, 0); /* make sure index SV is IV capable */
+           }
+           else
+               cx->blk_loop.iterlval = newSVsv(sv);
+       }
+    }
     else {
        cx->blk_loop.iterary = curstack;
-       AvFILLp(curstack) = sp - stack_base;
+       AvFILLp(curstack) = SP - stack_base;
        cx->blk_loop.iterix = MARK - stack_base;
     }
 
@@ -1454,7 +1472,7 @@ PP(pp_return)
     PMOP *newpm;
     I32 optype = 0;
 
-    if (curstack == sortstack) {
+    if (curstackinfo->si_type == PERLSI_SORT) {
        if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
            if (cxstack_ix > sortcxix)
                dounwind(sortcxix);
@@ -1493,10 +1511,22 @@ PP(pp_return)
 
     TAINT_NOT;
     if (gimme == G_SCALAR) {
-       if (MARK < SP)
-           *++newsp = (popsub2 && SvTEMP(*SP))
-                       ? *SP : sv_mortalcopy(*SP);
-       else
+       if (MARK < SP) {
+           if (popsub2) {
+               if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+                   if (SvTEMP(TOPs)) {
+                       *++newsp = SvREFCNT_inc(*SP);
+                       FREETMPS;
+                       sv_2mortal(*newsp);
+                   } else {
+                       FREETMPS;
+                       *++newsp = sv_mortalcopy(*SP);
+                   }
+               } else
+                   *++newsp = (SvTEMP(*SP)) ? *SP : sv_mortalcopy(*SP);
+           } else
+               *++newsp = sv_mortalcopy(*SP);
+       } else
            *++newsp = &sv_undef;
     }
     else if (gimme == G_ARRAY) {
@@ -1650,8 +1680,6 @@ PP(pp_redo)
     return cx->blk_loop.redo_op;
 }
 
-static OP* lastgotoprobe;
-
 STATIC OP *
 dofindlabel(OP *o, char *label, OP **opstack, OP **oplimit)
 {
@@ -1740,8 +1768,11 @@ PP(pp_goto)
            if (cxix < cxstack_ix)
                dounwind(cxix);
            TOPBLOCK(cx);
+           if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
+               DIE("Can't goto subroutine from an eval-string");
            mark = stack_sp;
-           if (cx->blk_sub.hasargs) {   /* put @_ back onto stack */
+           if (cx->cx_type == CXt_SUB &&
+               cx->blk_sub.hasargs) {   /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
                
                items = AvFILLp(av) + 1;
@@ -1756,7 +1787,22 @@ PP(pp_goto)
                AvREAL_off(av);
                av_clear(av);
            }
-           if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
+           else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
+               AV* av;
+               int i;
+#ifdef USE_THREADS
+               av = (AV*)curpad[0];
+#else
+               av = GvAV(defgv);
+#endif
+               items = AvFILLp(av) + 1;
+               stack_sp++;
+               EXTEND(stack_sp, items); /* @_ could have been extended. */
+               Copy(AvARRAY(av), stack_sp, items, SV*);
+               stack_sp += items;
+           }
+           if (cx->cx_type == CXt_SUB &&
+               !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
                SvREFCNT_dec(cx->blk_sub.cv);
            oldsave = scopestack[scopestack_ix - 1];
            LEAVE_SCOPE(oldsave);
@@ -1766,19 +1812,27 @@ PP(pp_goto)
            if (CvXSUB(cv)) {
                if (CvOLDSTYLE(cv)) {
                    I32 (*fp3)_((int,int,int));
-                   while (sp > mark) {
-                       sp[1] = sp[0];
-                       sp--;
+                   while (SP > mark) {
+                       SP[1] = SP[0];
+                       SP--;
                    }
                    fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
                    items = (*fp3)(CvXSUBANY(cv).any_i32,
                                   mark - stack_base + 1,
                                   items);
-                   sp = stack_base + items;
+                   SP = stack_base + items;
                }
                else {
+                   SV **newsp;
+                   I32 gimme;
+
                    stack_sp--;         /* There is no cv arg. */
-                   (void)(*CvXSUB(cv))(THIS_ cv);
+                   /* Push a mark for the start of arglist */
+                   PUSHMARK(mark); 
+                   (void)(*CvXSUB(cv))(cv _PERL_OBJECT_THIS);
+                   /* Pop the current context like a decent sub should */
+                   POPBLOCK(cx, curpm);
+                   /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
                }
                LEAVE;
                return pop_return();
@@ -1786,6 +1840,12 @@ PP(pp_goto)
            else {
                AV* padlist = CvPADLIST(cv);
                SV** svp = AvARRAY(padlist);
+               if (cx->cx_type == CXt_EVAL) {
+                   in_eval = cx->blk_eval.old_in_eval;
+                   eval_root = cx->blk_eval.old_eval_root;
+                   cx->cx_type = CXt_SUB;
+                   cx->blk_sub.hasargs = 0;
+               }
                cx->blk_sub.cv = cv;
                cx->blk_sub.olddepth = CvDEPTH(cv);
                CvDEPTH(cv)++;
@@ -1842,9 +1902,9 @@ PP(pp_goto)
                    items = AvFILLp(av) + 1;
                    if (items) {
                        /* Mark is at the end of the stack. */
-                       EXTEND(sp, items);
-                       Copy(AvARRAY(av), sp + 1, items, SV*);
-                       sp += items;
+                       EXTEND(SP, items);
+                       Copy(AvARRAY(av), SP + 1, items, SV*);
+                       SP += items;
                        PUTBACK ;                   
                    }
                }
@@ -1887,14 +1947,26 @@ PP(pp_goto)
                        mark++;
                    }
                }
-               if (PERLDB_SUB && curstash != debstash) {
+               if (PERLDB_SUB) {       /* Checking curstash breaks DProf. */
                    /*
                     * We do not care about using sv to call CV;
                     * it's for informational purposes only.
                     */
                    SV *sv = GvSV(DBsub);
-                   save_item(sv);
-                   gv_efullname3(sv, CvGV(cv), Nullch);
+                   CV *gotocv;
+                   
+                   if (PERLDB_SUB_NN) {
+                       SvIVX(sv) = (IV)cv; /* Already upgraded, saved */
+                   } else {
+                       save_item(sv);
+                       gv_efullname3(sv, CvGV(cv), Nullch);
+                   }
+                   if (  PERLDB_GOTO
+                         && (gotocv = perl_get_cv("DB::goto", FALSE)) ) {
+                       PUSHMARK( stack_sp );
+                       perl_call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+                       stack_sp--;
+                   }
                }
                RETURNOP(CvSTART(cv));
            }
@@ -1999,7 +2071,7 @@ PP(pp_goto)
        do_undump = FALSE;
     }
 
-    if (curstack == signalstack) {
+    if (top_env->je_prev) {
         restartop = retop;
         JMPENV_JUMP(3);
     }
@@ -2162,8 +2234,12 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
        introduced within evals. See force_ident(). GSAR 96-10-12 */
     safestr = savepv(tmpbuf);
     SAVEDELETE(defstash, safestr, strlen(safestr));
-    SAVEI32(hints);
+    SAVEHINTS();
+#ifdef OP_IN_REGISTER
+    opsave = op;
+#else
     SAVEPPTR(op);
+#endif
     hints = 0;
 
     op = &dummy;
@@ -2180,6 +2256,9 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
     lex_end();
     *avp = (AV*)SvREFCNT_inc(comppad);
     LEAVE;
+#ifdef OP_IN_REGISTER
+    op = opsave;
+#endif
     return rop;
 }
 
@@ -2338,7 +2417,7 @@ doeval(int gimme, OP** startop)
        CV *cv = perl_get_cv("DB::postponed", FALSE);
        if (cv) {
            dSP;
-           PUSHMARK(sp);
+           PUSHMARK(SP);
            XPUSHs((SV*)compiling.cop_filegv);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
@@ -2366,6 +2445,7 @@ PP(pp_require)
     register PERL_CONTEXT *cx;
     SV *sv;
     char *name;
+    STRLEN len;
     char *tryname;
     SV *namesv = Nullsv;
     SV** svp;
@@ -2380,12 +2460,12 @@ PP(pp_require)
                SvPV(sv,na),patchlevel);
        RETPUSHYES;
     }
-    name = SvPV(sv, na);
-    if (!*name)
+    name = SvPV(sv, len);
+    if (!(name && len > 0 && *name))
        DIE("Null filename used");
     TAINT_PROPER("require");
     if (op->op_type == OP_REQUIRE &&
-      (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
+      (svp = hv_fetch(GvHVn(incgv), name, len, 0)) &&
       *svp != &sv_undef)
        RETPUSHYES;
 
@@ -2482,7 +2562,7 @@ PP(pp_require)
     rsfp = tryrsfp;
     name = savepv(name);
     SAVEFREEPV(name);
-    SAVEI32(hints);
+    SAVEHINTS();
     hints = 0;
  
     /* switch to eval mode */
@@ -2542,7 +2622,7 @@ PP(pp_entereval)
        introduced within evals. See force_ident(). GSAR 96-10-12 */
     safestr = savepv(tmpbuf);
     SAVEDELETE(defstash, safestr, strlen(safestr));
-    SAVEI32(hints);
+    SAVEHINTS();
     hints = op->op_targ;
 
     push_return(op->op_next);
@@ -2647,21 +2727,22 @@ PP(pp_leaveeval)
     assert(CvDEPTH(compcv) == 1);
 #endif
     CvDEPTH(compcv) = 0;
+    lex_end();
 
     if (optype == OP_REQUIRE &&
-       !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp))
+       !(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
     {
        /* Unassume the success we assumed earlier. */
        char *name = cx->blk_eval.old_name;
        (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
        retop = die("%s did not return a true value", name);
+       /* die_where() did LEAVE, or we won't be here */
+    }
+    else {
+       LEAVE;
+       if (!(save_flags & OPf_SPECIAL))
+           sv_setpv(ERRSV,"");
     }
-
-    lex_end();
-    LEAVE;
-
-    if (!(save_flags & OPf_SPECIAL))
-       sv_setpv(ERRSV,"");
 
     RETURNOP(retop);
 }
@@ -3017,8 +3098,13 @@ struct partition_stack_entry {
 
 /* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2
 */
+#ifdef PERL_OBJECT
+#define qsort_cmp(elt1, elt2) \
+   ((this->*compare)(array[elt1], array[elt2]))
+#else
 #define qsort_cmp(elt1, elt2) \
    ((*compare)(array[elt1], array[elt2]))
+#endif
 
 #ifdef QSORT_ORDER_GUESS
 #define QSORT_NOTICE_SWAP swapped++;
@@ -3099,10 +3185,14 @@ doqsort_all_asserts(
 /* ****************************************************************** qsort */
 
 void
+#ifdef PERL_OBJECT
+qsortsv(SV ** array, size_t num_elts, SVCOMPARE compare)
+#else
 qsortsv(
    SV ** array,
    size_t num_elts,
    I32 (*compare)(SV *a, SV *b))
+#endif
 {
    register SV * temp;
 
@@ -3565,9 +3655,10 @@ qsortsv(
             if (j != i) {
                /* Looks like we really need to move some things
                */
+              int k;
               temp = array[i];
-              for (--i; i >= j; --i)
-                 array[i + 1] = array[i];
+              for (k = i - 1; k >= j; --k)
+                 array[k + 1] = array[k];
                array[j] = temp;
             }
          }