PATCH to perl5.005_54/pod/perldsc.pod (fix typo)
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 48a2ed2..3263b34 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -41,6 +41,12 @@ static void save_lines _((AV *array, SV *sv));
 static I32 sortcv _((SV *a, SV *b));
 static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
 static OP *doeval _((int gimme, OP** startop));
+static I32 sv_ncmp _((SV *a, SV *b));
+static I32 sv_i_ncmp _((SV *a, SV *b));
+static I32 amagic_ncmp _((SV *a, SV *b));
+static I32 amagic_i_ncmp _((SV *a, SV *b));
+I32 amagic_cmp _((SV *str1, SV *str2));
+I32 amagic_cmp_locale _((SV *str1, SV *str2));
 #endif
 
 PP(pp_wantarray)
@@ -162,8 +168,10 @@ PP(pp_substcont)
 
        /* Are we done */
        if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
-                                    s == m, Nullsv, NULL,
-                                    cx->sb_safebase ? 0 : REXEC_COPY_STR))
+                                    s == m, cx->sb_targ, NULL,
+                                    ((cx->sb_rflags & REXEC_COPY_STR)
+                                     ? REXEC_IGNOREPOS 
+                                     : (REXEC_COPY_STR|REXEC_IGNOREPOS))))
        {
            SV *targ = cx->sb_targ;
            sv_catpvn(dstr, s, cx->sb_strend - s);
@@ -615,7 +623,13 @@ PP(pp_formline)
            break;
 
        case FF_MORE:
-           if (itemsize) {
+           s = chophere;
+           send = item + len;
+           if (chopspace) {
+               while (*s && isSPACE(*s) && s < send)
+                   s++;
+           }
+           if (s < send) {
                arg = fieldsize - itemsize;
                if (arg) {
                    fieldsize -= arg;
@@ -660,12 +674,8 @@ PP(pp_grepstart)
     ENTER;                                     /* enter outer scope */
 
     SAVETMPS;
-#ifdef USE_THREADS
-    /* SAVE_DEFSV does *not* suffice here */
-    save_sptr(&THREADSV(0));
-#else
-    SAVESPTR(GvSV(PL_defgv));
-#endif /* USE_THREADS */
+    /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
+    SAVESPTR(DEFSV);
     ENTER;                                     /* enter inner scope */
     SAVESPTR(PL_curpm);
 
@@ -747,6 +757,119 @@ PP(pp_mapwhile)
     }
 }
 
+STATIC I32
+sv_ncmp (SV *a, SV *b)
+{
+    double nv1 = SvNV(a);
+    double nv2 = SvNV(b);
+    return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
+}
+STATIC I32
+sv_i_ncmp (SV *a, SV *b)
+{
+    IV iv1 = SvIV(a);
+    IV iv2 = SvIV(b);
+    return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
+}
+#define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \
+         *svp = Nullsv;                                \
+          if (PL_amagic_generation) { \
+           if (SvAMAGIC(left)||SvAMAGIC(right))\
+               *svp = amagic_call(left, \
+                                  right, \
+                                  CAT2(meth,_amg), \
+                                  0); \
+         } \
+       } STMT_END
+
+STATIC I32
+amagic_ncmp(register SV *a, register SV *b)
+{
+    SV *tmpsv;
+    tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
+    if (tmpsv) {
+       double d;
+       
+        if (SvIOK(tmpsv)) {
+            I32 i = SvIVX(tmpsv);
+            if (i > 0)
+               return 1;
+            return i? -1 : 0;
+        }
+        d = SvNV(tmpsv);
+        if (d > 0)
+           return 1;
+        return d? -1 : 0;
+     }
+     return sv_ncmp(a, b);
+}
+
+STATIC I32
+amagic_i_ncmp(register SV *a, register SV *b)
+{
+    SV *tmpsv;
+    tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
+    if (tmpsv) {
+       double d;
+       
+        if (SvIOK(tmpsv)) {
+            I32 i = SvIVX(tmpsv);
+            if (i > 0)
+               return 1;
+            return i? -1 : 0;
+        }
+        d = SvNV(tmpsv);
+        if (d > 0)
+           return 1;
+        return d? -1 : 0;
+    }
+    return sv_i_ncmp(a, b);
+}
+
+I32
+amagic_cmp(register SV *str1, register SV *str2)
+{
+    SV *tmpsv;
+    tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+    if (tmpsv) {
+       double d;
+       
+        if (SvIOK(tmpsv)) {
+            I32 i = SvIVX(tmpsv);
+            if (i > 0)
+               return 1;
+            return i? -1 : 0;
+        }
+        d = SvNV(tmpsv);
+        if (d > 0)
+           return 1;
+        return d? -1 : 0;
+    }
+    return sv_cmp(str1, str2);
+}
+
+I32
+amagic_cmp_locale(register SV *str1, register SV *str2)
+{
+    SV *tmpsv;
+    tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+    if (tmpsv) {
+       double d;
+       
+        if (SvIOK(tmpsv)) {
+            I32 i = SvIVX(tmpsv);
+            if (i > 0)
+               return 1;
+            return i? -1 : 0;
+        }
+        d = SvNV(tmpsv);
+        if (d > 0)
+           return 1;
+        return d? -1 : 0;
+    }
+    return sv_cmp_locale(str1, str2);
+}
+
 PP(pp_sort)
 {
     djSP; dMARK; dORIGMARK;
@@ -758,6 +881,7 @@ PP(pp_sort)
     CV *cv;
     I32 gimme = GIMME;
     OP* nextop = PL_op->op_next;
+    I32 overloading = 0;
 
     if (gimme != G_ARRAY) {
        SP = MARK;
@@ -794,7 +918,7 @@ PP(pp_sort)
            }
            PL_sortcop = CvSTART(cv);
            SAVESPTR(CvROOT(cv)->op_ppaddr);
-           CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
+           CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
 
            SAVESPTR(PL_curpad);
            PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
@@ -810,8 +934,13 @@ PP(pp_sort)
        /*SUPPRESS 560*/
        if (*up = *++MARK) {                    /* Weed out nulls. */
            SvTEMP_off(*up);
-           if (!PL_sortcop && !SvPOK(*up))
-               (void)sv_2pv(*up, &PL_na);
+           if (!PL_sortcop && !SvPOK(*up)) {
+               STRLEN n_a;
+               if (SvAMAGIC(*up))
+                   overloading = 1;
+               else
+                   (void)sv_2pv(*up, &n_a);
+           }
            up++;
        }
     }
@@ -849,6 +978,7 @@ PP(pp_sort)
            qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
 
            POPBLOCK(cx,PL_curpm);
+           PL_stack_sp = newsp;
            POPSTACK;
            CATCH_SET(oldcatch);
        }
@@ -857,9 +987,30 @@ PP(pp_sort)
        if (max > 1) {
            MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
            qsortsv(ORIGMARK+1, max,
-                   (PL_op->op_private & OPpLOCALE)
-                   ? FUNC_NAME_TO_PTR(sv_cmp_locale)
-                   : FUNC_NAME_TO_PTR(sv_cmp));
+                   (PL_op->op_private & OPpSORT_NUMERIC)
+                       ? ( (PL_op->op_private & OPpSORT_INTEGER)
+                           ? ( overloading
+                               ? FUNC_NAME_TO_PTR(amagic_i_ncmp)
+                               : FUNC_NAME_TO_PTR(sv_i_ncmp))
+                           : ( overloading
+                               ? FUNC_NAME_TO_PTR(amagic_ncmp)
+                               : FUNC_NAME_TO_PTR(sv_ncmp)))
+                       : ( (PL_op->op_private & OPpLOCALE)
+                           ? ( overloading
+                               ? FUNC_NAME_TO_PTR(amagic_cmp_locale)
+                               : FUNC_NAME_TO_PTR(sv_cmp_locale))
+                           : ( overloading
+                               ? FUNC_NAME_TO_PTR(amagic_cmp)
+                   : FUNC_NAME_TO_PTR(sv_cmp) )));
+           if (PL_op->op_private & OPpSORT_REVERSE) {
+               SV **p = ORIGMARK+1;
+               SV **q = ORIGMARK+max;
+               while (p < q) {
+                   SV *tmp = *p;
+                   *p++ = *q;
+                   *q-- = tmp;
+               }
+           }
        }
     }
     LEAVE;
@@ -936,11 +1087,11 @@ PP(pp_flop)
        }
        else {
            SV *final = sv_mortalcopy(right);
-           STRLEN len;
+           STRLEN len, n_a;
            char *tmps = SvPV(final, len);
 
            sv = sv_mortalcopy(left);
-           SvPV_force(sv,PL_na);
+           SvPV_force(sv,n_a);
            while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
                XPUSHs(sv);
                if (strEQ(SvPVX(sv),tmps))
@@ -977,26 +1128,26 @@ dopoptolabel(char *label)
 
     for (i = cxstack_ix; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        case CXt_SUBST:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting substitution via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            break;
        case CXt_SUB:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting subroutine via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            break;
        case CXt_EVAL:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting eval via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            break;
        case CXt_NULL:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting pseudo-block via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            return -1;
        case CXt_LOOP:
            if (!cx->blk_loop.label ||
@@ -1058,7 +1209,7 @@ dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock)
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
        cx = &cxstk[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        default:
            continue;
        case CXt_EVAL:
@@ -1078,7 +1229,7 @@ dopoptoeval(I32 startingblock)
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        default:
            continue;
        case CXt_EVAL:
@@ -1097,26 +1248,26 @@ dopoptoloop(I32 startingblock)
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        case CXt_SUBST:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting substitution via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            break;
        case CXt_SUB:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting subroutine via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            break;
        case CXt_EVAL:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting eval via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            break;
        case CXt_NULL:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting pseudo-block via %s", 
-                       op_name[PL_op->op_type]);
+                       PL_op_name[PL_op->op_type]);
            return -1;
        case CXt_LOOP:
            DEBUG_l( deb("(Found loop #%ld)\n", (long)i));
@@ -1137,9 +1288,9 @@ 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, block_type[cx->cx_type]));
+                             (long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
        /* Note: we don't need to restore the base context info till the end. */
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        case CXt_SUBST:
            POPSUBST(cx);
            continue;  /* not break */
@@ -1163,6 +1314,7 @@ OP *
 die_where(char *message)
 {
     dSP;
+    STRLEN n_a;
     if (PL_in_eval) {
        I32 cxix;
        register PERL_CONTEXT *cx;
@@ -1186,6 +1338,10 @@ die_where(char *message)
                        SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
                        sv_catpvn(err, prefix, sizeof(prefix)-1);
                        sv_catpvn(err, message, klen);
+                       if (ckWARN(WARN_UNSAFE)) {
+                           STRLEN start = SvCUR(err)-klen-sizeof(prefix)+1;
+                           warner(WARN_UNSAFE, SvPVX(err)+start);
+                       }
                    }
                    sv_inc(*svp);
                }
@@ -1194,7 +1350,7 @@ die_where(char *message)
                sv_setpv(ERRSV, message);
        }
        else
-           message = SvPVx(ERRSV, PL_na);
+           message = SvPVx(ERRSV, n_a);
 
        while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
            dounwind(-1);
@@ -1208,7 +1364,7 @@ die_where(char *message)
                dounwind(cxix);
 
            POPBLOCK(cx,PL_curpm);
-           if (cx->cx_type != CXt_EVAL) {
+           if (CxTYPE(cx) != CXt_EVAL) {
                PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
                my_exit(1);
            }
@@ -1221,12 +1377,14 @@ die_where(char *message)
            LEAVE;
 
            if (optype == OP_REQUIRE) {
-               char* msg = SvPVx(ERRSV, PL_na);
+               char* msg = SvPVx(ERRSV, n_a);
                DIE("%s", *msg ? msg : "Compilation failed in require");
            }
            return pop_return();
        }
     }
+    if (!message)
+       message = SvPVx(ERRSV, n_a);
     PerlIO_printf(PerlIO_stderr(), "%s",message);
     PerlIO_flush(PerlIO_stderr());
     my_failure_exit();
@@ -1298,7 +1456,7 @@ PP(pp_caller)
     }
 
     cx = &ccstack[cxix];
-    if (ccstack[cxix].cx_type == CXt_SUB) {
+    if (CxTYPE(cx) == CXt_SUB) {
         dbcxix = dopoptosub_at(ccstack, cxix - 1);
        /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
           field below is defined for any cx. */
@@ -1327,7 +1485,7 @@ PP(pp_caller)
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
        RETURN;
-    if (cx->cx_type == CXt_SUB) { /* So is ccstack[dbcxix]. */
+    if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
        sv = NEWSV(49, 0);
        gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
        PUSHs(sv_2mortal(sv));
@@ -1342,7 +1500,7 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
     else
        PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
-    if (cx->cx_type == CXt_EVAL) {
+    if (CxTYPE(cx) == CXt_EVAL) {
        if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
            PUSHs(cx->blk_eval.cur_text);
            PUSHs(&PL_sv_no);
@@ -1353,7 +1511,7 @@ PP(pp_caller)
            PUSHs(&PL_sv_yes);
        }
     }
-    else if (cx->cx_type == CXt_SUB &&
+    else if (CxTYPE(cx) == CXt_SUB &&
            cx->blk_sub.hasargs &&
            PL_curcop->cop_stash == PL_debstash)
     {
@@ -1404,11 +1562,12 @@ PP(pp_reset)
 {
     djSP;
     char *tmps;
+    STRLEN n_a;
 
     if (MAXARG < 1)
        tmps = "";
     else
-       tmps = POPp;
+       tmps = POPpx;
     sv_reset(tmps, PL_curcop->cop_stash);
     PUSHs(&PL_sv_yes);
     RETURN;
@@ -1610,7 +1769,7 @@ PP(pp_return)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
-    switch (cx->cx_type) {
+    switch (CxTYPE(cx)) {
     case CXt_SUB:
        POPSUB1(cx);    /* Delay POPSUB2 until stack values are safe */
        popsub2 = TRUE;
@@ -1698,7 +1857,7 @@ PP(pp_last)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
-    switch (cx->cx_type) {
+    switch (CxTYPE(cx)) {
     case CXt_LOOP:
        POPLOOP1(cx);   /* Delay POPLOOP2 until stack values are safe */
        pop2 = CXt_LOOP;
@@ -1864,6 +2023,7 @@ PP(pp_goto)
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *sv = POPs;
+       STRLEN n_a;
 
        /* This egregious kludge implements goto &subroutine */
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
@@ -1873,11 +2033,23 @@ PP(pp_goto)
            SV** mark;
            I32 items = 0;
            I32 oldsave;
+           int arg_was_real = 0;
 
+       retry:
            if (!CvROOT(cv) && !CvXSUB(cv)) {
-               if (CvGV(cv)) {
-                   SV *tmpstr = sv_newmortal();
-                   gv_efullname3(tmpstr, CvGV(cv), Nullch);
+               GV *gv = CvGV(cv);
+               GV *autogv;
+               if (gv) {
+                   SV *tmpstr;
+                   /* autoloaded stub? */
+                   if (cv != GvCV(gv) && (cv = GvCV(gv)))
+                       goto retry;
+                   autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv),
+                                         GvNAMELEN(gv), FALSE);
+                   if (autogv && (cv = GvCV(autogv)))
+                       goto retry;
+                   tmpstr = sv_newmortal();
+                   gv_efullname3(tmpstr, gv, Nullch);
                    DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
                }
                DIE("Goto undefined subroutine");
@@ -1890,10 +2062,10 @@ 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) 
+           if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
                DIE("Can't goto subroutine from an eval-string");
            mark = PL_stack_sp;
-           if (cx->cx_type == CXt_SUB &&
+           if (CxTYPE(cx) == CXt_SUB &&
                cx->blk_sub.hasargs) {   /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
                
@@ -1906,7 +2078,10 @@ PP(pp_goto)
                SvREFCNT_dec(GvAV(PL_defgv));
                GvAV(PL_defgv) = cx->blk_sub.savearray;
 #endif /* USE_THREADS */
-               AvREAL_off(av);
+               if (AvREAL(av)) {
+                   arg_was_real = 1;
+                   AvREAL_off(av);     /* so av_clear() won't clobber elts */
+               }
                av_clear(av);
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
@@ -1923,7 +2098,7 @@ PP(pp_goto)
                Copy(AvARRAY(av), PL_stack_sp, items, SV*);
                PL_stack_sp += items;
            }
-           if (cx->cx_type == CXt_SUB &&
+           if (CxTYPE(cx) == CXt_SUB &&
                !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
                SvREFCNT_dec(cx->blk_sub.cv);
            oldsave = PL_scopestack[PL_scopestack_ix - 1];
@@ -1962,7 +2137,7 @@ PP(pp_goto)
            else {
                AV* padlist = CvPADLIST(cv);
                SV** svp = AvARRAY(padlist);
-               if (cx->cx_type == CXt_EVAL) {
+               if (CxTYPE(cx) == CXt_EVAL) {
                    PL_in_eval = cx->blk_eval.old_in_eval;
                    PL_eval_root = cx->blk_eval.old_eval_root;
                    cx->cx_type = CXt_SUB;
@@ -2062,7 +2237,11 @@ PP(pp_goto)
                    }
                    Copy(mark,AvARRAY(av),items,SV*);
                    AvFILLp(av) = items - 1;
-                   
+                   /* preserve @_ nature */
+                   if (arg_was_real) {
+                       AvREIFY_off(av);
+                       AvREAL_on(av);
+                   }
                    while (items--) {
                        if (*mark)
                            SvTEMP_off(*mark);
@@ -2094,7 +2273,7 @@ PP(pp_goto)
            }
        }
        else
-           label = SvPV(sv,PL_na);
+           label = SvPV(sv,n_a);
     }
     else if (PL_op->op_flags & OPf_SPECIAL) {
        if (! do_dump)
@@ -2112,7 +2291,7 @@ PP(pp_goto)
        *enterops = 0;
        for (ix = cxstack_ix; ix >= 0; ix--) {
            cx = &cxstack[ix];
-           switch (cx->cx_type) {
+           switch (CxTYPE(cx)) {
            case CXt_EVAL:
                gotoprobe = PL_eval_root; /* XXX not good for nested eval */
                break;
@@ -2193,11 +2372,6 @@ PP(pp_goto)
        PL_do_undump = FALSE;
     }
 
-    if (PL_top_env->je_prev) {
-        PL_restartop = retop;
-        JMPENV_JUMP(3);
-    }
-
     RETURNOP(retop);
 }
 
@@ -2248,7 +2422,8 @@ PP(pp_cswitch)
     if (PL_multiline)
        PL_op = PL_op->op_next;                 /* can't assume anything */
     else {
-       match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255;
+       STRLEN n_a;
+       match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255;
        match -= cCOP->uop.scop.scop_offset;
        if (match < 0)
            match = 0;
@@ -2302,15 +2477,14 @@ docatch(OP *o)
     JMPENV_PUSH(ret);
     switch (ret) {
     default:                           /* topmost level handles it */
+pass_the_buck:
        JMPENV_POP;
        PL_op = oldop;
        JMPENV_JUMP(ret);
        /* NOTREACHED */
     case 3:
-       if (!PL_restartop) {
-           PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
-           break;
-       }
+       if (!PL_restartop)
+           goto pass_the_buck;
        PL_op = PL_restartop;
        PL_restartop = 0;
        /* FALL THROUGH */
@@ -2369,7 +2543,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
     PL_hints = 0;
 
     PL_op = &dummy;
-    PL_op->op_type = 0;                        /* Avoid uninit warning. */
+    PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL, SP);
     PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
@@ -2378,11 +2552,11 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
     POPEVAL(cx);
 
     (*startop)->op_type = OP_NULL;
-    (*startop)->op_ppaddr = ppaddr[OP_NULL];
+    (*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
     lex_end();
     *avp = (AV*)SvREFCNT_inc(PL_comppad);
     LEAVE;
-    if (curcop = &PL_compiling)
+    if (PL_curcop == &PL_compiling)
        PL_compiling.op_private = PL_hints;
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
@@ -2416,11 +2590,11 @@ doeval(int gimme, OP** startop)
     SAVEI32(PL_max_intro_pending);
 
     caller = PL_compcv;
-    for (i = cxstack_ix; i >= 0; i--) {
+    for (i = cxstack_ix - 1; i >= 0; i--) {
        PERL_CONTEXT *cx = &cxstack[i];
-       if (cx->cx_type == CXt_EVAL)
+       if (CxTYPE(cx) == CXt_EVAL)
            break;
-       else if (cx->cx_type == CXt_SUB) {
+       else if (CxTYPE(cx) == CXt_SUB) {
            caller = cx->blk_sub.cv;
            break;
        }
@@ -2488,6 +2662,7 @@ doeval(int gimme, OP** startop)
        I32 gimme;
        PERL_CONTEXT *cx;
        I32 optype = 0;                 /* Might be reset by POPEVAL. */
+       STRLEN n_a;
 
        PL_op = saveop;
        if (PL_eval_root) {
@@ -2503,10 +2678,10 @@ doeval(int gimme, OP** startop)
        lex_end();
        LEAVE;
        if (optype == OP_REQUIRE) {
-           char* msg = SvPVx(ERRSV, PL_na);
+           char* msg = SvPVx(ERRSV, n_a);
            DIE("%s", *msg ? msg : "Compilation failed in require");
        } else if (startop) {
-           char* msg = SvPVx(ERRSV, PL_na);
+           char* msg = SvPVx(ERRSV, n_a);
 
            POPBLOCK(cx,PL_curpm);
            POPEVAL(cx);
@@ -2579,13 +2754,14 @@ PP(pp_require)
     SV** svp;
     I32 gimme = G_SCALAR;
     PerlIO *tryrsfp = 0;
+    STRLEN n_a;
 
     sv = POPs;
     if (SvNIOKp(sv) && !SvPOKp(sv)) {
        SET_NUMERIC_STANDARD();
        if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
            DIE("Perl %s required--this is only version %s, stopped",
-               SvPV(sv,PL_na),PL_patchlevel);
+               SvPV(sv,n_a),PL_patchlevel);
        RETPUSHYES;
     }
     name = SvPV(sv, len);
@@ -2628,7 +2804,7 @@ PP(pp_require)
        {
            namesv = NEWSV(806, 0);
            for (i = 0; i <= AvFILL(ar); i++) {
-               char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+               char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
 #ifdef VMS
                char *unixdir;
                if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
@@ -2638,6 +2814,7 @@ PP(pp_require)
 #else
                sv_setpvf(namesv, "%s/%s", dir, name);
 #endif
+               TAINT_PROPER("require");
                tryname = SvPVX(namesv);
                tryrsfp = PerlIO_open(tryname, PERL_SCRIPT_MODE);
                if (tryrsfp) {
@@ -2663,7 +2840,7 @@ PP(pp_require)
                sv_catpv(msg, " (did you run h2ph?)");
            sv_catpv(msg, " (@INC contains:");
            for (i = 0; i <= AvFILL(ar); i++) {
-               char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+               char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
                sv_setpvf(dirmsgsv, " %s", dir);
                sv_catsv(msg, dirmsgsv);
            }
@@ -2675,7 +2852,7 @@ PP(pp_require)
        RETPUSHUNDEF;
     }
     else
-       errno = 0;
+       SETERRNO(0, SS$_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
     (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
@@ -2684,10 +2861,8 @@ PP(pp_require)
     ENTER;
     SAVETMPS;
     lex_start(sv_2mortal(newSVpv("",0)));
-    if (PL_rsfp_filters){
-       save_aptr(&PL_rsfp_filters);
-       PL_rsfp_filters = NULL;
-    }
+    SAVEGENERICSV(PL_rsfp_filters);
+    PL_rsfp_filters = Nullav;
 
     PL_rsfp = tryrsfp;
     name = savepv(name);
@@ -2758,7 +2933,7 @@ PP(pp_entereval)
     SAVEDELETE(PL_defstash, safestr, strlen(safestr));
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
-    SAVEPPTR(compiling.cop_warnings);
+    SAVEPPTR(PL_compiling.cop_warnings);
     if (PL_compiling.cop_warnings != WARN_ALL 
        && PL_compiling.cop_warnings != WARN_NONE){
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
@@ -2766,7 +2941,7 @@ PP(pp_entereval)
     }
 
     push_return(PL_op->op_next);
-    PUSHBLOCK(cx, CXt_EVAL, SP);
+    PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
     PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
 
     /* prepare to compile string */