[perl #37725] perl segfaults on reversed array reference

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index d0e2ef6..45ca9ea 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -60,11 +60,6 @@ PP(pp_wantarray)
     }
 }
 
     }
 }
 

-PP(pp_regcmaybe)
-{
-    return NORMAL;
-}
-

 PP(pp_regcreset)
 {
     /* XXXX Should store the old value to allow for tie/overload - and
 PP(pp_regcreset)
 {
     /* XXXX Should store the old value to allow for tie/overload - and


@@ -122,7 +117,7 @@ PP(pp_regcomp)
            mg = mg_find(sv, PERL_MAGIC_qr);
     }
     if (mg) {
            mg = mg_find(sv, PERL_MAGIC_qr);
     }
     if (mg) {

-       regexp *re = (regexp *)mg->mg_obj;
+       regexp * const re = (regexp *)mg->mg_obj;

        ReREFCNT_dec(PM_GETRE(pm));
        PM_SETRE(pm, ReREFCNT_inc(re));
     }
        ReREFCNT_dec(PM_GETRE(pm));
        PM_SETRE(pm, ReREFCNT_inc(re));
     }


@@ -204,7 +199,7 @@ PP(pp_substcont)
     }
 
     rxres_restore(&cx->sb_rxres, rx);
     }
 
     rxres_restore(&cx->sb_rxres, rx);

-    RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ));
+    RX_MATCH_UTF8_set(rx, DO_UTF8(cx->sb_targ));

 
     if (cx->sb_iters++) {
        const I32 saviters = cx->sb_iters;
 
     if (cx->sb_iters++) {
        const I32 saviters = cx->sb_iters;


@@ -222,7 +217,7 @@ PP(pp_substcont)
                                      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
                                      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
        {
                                      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
                                      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
        {

-           SV *targ = cx->sb_targ;
+           SV * const targ = cx->sb_targ;

 
            assert(cx->sb_strend >= s);
            if(cx->sb_strend > s) {
 
            assert(cx->sb_strend >= s);
            if(cx->sb_strend > s) {


@@ -280,7 +275,7 @@ PP(pp_substcont)
     }
     cx->sb_s = rx->endp[0] + orig;
     { /* Update the pos() information. */
     }
     cx->sb_s = rx->endp[0] + orig;
     { /* Update the pos() information. */

-       SV *sv = cx->sb_targ;
+       SV * const sv = cx->sb_targ;

        MAGIC *mg;
        I32 i;
        if (SvTYPE(sv) < SVt_PVMG)
        MAGIC *mg;
        I32 i;
        if (SvTYPE(sv) < SVt_PVMG)


@@ -314,7 +309,7 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
        i = 6 + rx->nparens * 2;
 #endif
        if (!p)
        i = 6 + rx->nparens * 2;
 #endif
        if (!p)

-           New(501, p, i, UV);
+           Newx(p, i, UV);

        else
            Renew(p, i, UV);
        *rsp = (void*)p;
        else
            Renew(p, i, UV);
        *rsp = (void*)p;


@@ -368,7 +363,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 void
 Perl_rxres_free(pTHX_ void **rsp)
 {
 void
 Perl_rxres_free(pTHX_ void **rsp)
 {

-    UV *p = (UV*)*rsp;
+    UV * const p = (UV*)*rsp;

 
     if (p) {
 #ifdef PERL_POISON
 
     if (p) {
 #ifdef PERL_POISON


@@ -392,7 +387,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;

-    register SV *tmpForm = *++MARK;
+    register SV * const tmpForm = *++MARK;

     register U32 *fpc;
     register char *t;
     const char *f;
     register U32 *fpc;
     register char *t;
     const char *f;


@@ -408,7 +403,7 @@ PP(pp_formline)
     NV value;
     bool gotsome = FALSE;
     STRLEN len;
     NV value;
     bool gotsome = FALSE;
     STRLEN len;

-    STRLEN fudge = SvPOK(tmpForm)
+    const STRLEN fudge = SvPOK(tmpForm)

                        ? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
                        ? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;


@@ -731,7 +726,7 @@ PP(pp_formline)
            {
                const char *s = chophere;
                if (chopspace) {
            {
                const char *s = chophere;
                if (chopspace) {

-                   while (*s && isSPACE(*s))
+                   while (isSPACE(*s))

                        s++;
                }
                sv_chop(sv,s);
                        s++;
                }
                sv_chop(sv,s);


@@ -869,7 +864,7 @@ PP(pp_formline)
                const char *s = chophere;
                const char *send = item + len;
                if (chopspace) {
                const char *s = chophere;
                const char *send = item + len;
                if (chopspace) {

-                   while (*s && isSPACE(*s) && s < send)
+                   while (isSPACE(*s) && (s < send))

                        s++;
                }
                if (s < send) {
                        s++;
                }
                if (s < send) {


@@ -940,11 +935,6 @@ PP(pp_grepstart)
     return ((LOGOP*)PL_op->op_next)->op_other;
 }
 
     return ((LOGOP*)PL_op->op_next)->op_other;
 }
 

-PP(pp_mapstart)
-{
-    DIE(aTHX_ "panic: mapstart");      /* uses grepstart */
-}
-

 PP(pp_mapwhile)
 {
     dVAR; dSP;
 PP(pp_mapwhile)
 {
     dVAR; dSP;


@@ -1075,7 +1065,7 @@ PP(pp_flip)
     }
     else {
        dTOPss;
     }
     else {
        dTOPss;

-       SV *targ = PAD_SV(PL_op->op_targ);
+       SV * const targ = PAD_SV(PL_op->op_targ);

        int flip = 0;
 
        if (PL_op->op_private & OPpFLIP_LINENUM) {
        int flip = 0;
 
        if (PL_op->op_private & OPpFLIP_LINENUM) {


@@ -1083,8 +1073,9 @@ PP(pp_flip)
                flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
            }
            else {
                flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
            }
            else {

-               GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
-               if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv));
+               GV * const gv = gv_fetchpv(".", TRUE, SVt_PV);
+               if (gv && GvSV(gv))
+                   flip = SvIV(sv) == SvIV(GvSV(gv));

            }
        } else {
            flip = SvTRUE(sv);
            }
        } else {
            flip = SvTRUE(sv);


@@ -1126,10 +1117,8 @@ PP(pp_flop)
     if (GIMME == G_ARRAY) {
        dPOPPOPssrl;
 
     if (GIMME == G_ARRAY) {
        dPOPPOPssrl;
 

-       if (SvGMAGICAL(left))
-           mg_get(left);
-       if (SvGMAGICAL(right))
-           mg_get(right);
+       SvGETMAGIC(left);
+       SvGETMAGIC(right);

 
        if (RANGE_IS_NUMERIC(left,right)) {
            register IV i, j;
 
        if (RANGE_IS_NUMERIC(left,right)) {
            register IV i, j;


@@ -1152,9 +1141,9 @@ PP(pp_flop)
            }
        }
        else {
            }
        }
        else {

-           SV *final = sv_mortalcopy(right);
+           SV * const final = sv_mortalcopy(right);

            STRLEN len;
            STRLEN len;

-           const char *tmps = SvPV_const(final, len);
+           const char * const tmps = SvPV_const(final, len);

 
            SV *sv = sv_mortalcopy(left);
            SvPV_force_nolen(sv);
 
            SV *sv = sv_mortalcopy(left);
            SvPV_force_nolen(sv);


@@ -1408,7 +1397,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
        if (message) {
            if (PL_in_eval & EVAL_KEEPERR) {
                 static const char prefix[] = "\t(in cleanup) ";
        if (message) {
            if (PL_in_eval & EVAL_KEEPERR) {
                 static const char prefix[] = "\t(in cleanup) ";

-               SV *err = ERRSV;
+               SV * const err = ERRSV;

                 const char *e = Nullch;
                if (!SvPOK(err))
                    sv_setpvn(err,"",0);
                 const char *e = Nullch;
                if (!SvPOK(err))
                    sv_setpvn(err,"",0);


@@ -1472,7 +1461,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
            PL_curcop = cx->blk_oldcop;
 
            if (optype == OP_REQUIRE) {
            PL_curcop = cx->blk_oldcop;
 
            if (optype == OP_REQUIRE) {

-                const char* msg = SvPVx_nolen_const(ERRSV);
+                const char* const msg = SvPVx_nolen_const(ERRSV);

                SV * const nsv = cx->blk_eval.old_namesv;
                 (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                                &PL_sv_undef, 0);
                SV * const nsv = cx->blk_eval.old_namesv;
                 (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                                &PL_sv_undef, 0);


@@ -1501,57 +1490,6 @@ PP(pp_xor)
        RETSETNO;
 }
 
        RETSETNO;
 }
 

-PP(pp_andassign)
-{
-    dSP;
-    if (!SvTRUE(TOPs))
-       RETURN;
-    else
-       RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_orassign)
-{
-    dSP;
-    if (SvTRUE(TOPs))
-       RETURN;
-    else
-       RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_dorassign)
-{
-    dSP;
-    register SV* sv;
-
-    sv = TOPs;
-    if (!sv || !SvANY(sv)) {
-       RETURNOP(cLOGOP->op_other);
-    }
-
-    switch (SvTYPE(sv)) {
-    case SVt_PVAV:
-       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-           RETURN;
-       break;
-    case SVt_PVHV:
-       if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-           RETURN;
-       break;
-    case SVt_PVCV:
-       if (CvROOT(sv) || CvXSUB(sv))
-           RETURN;
-       break;
-    default:
-       if (SvGMAGICAL(sv))
-           mg_get(sv);
-       if (SvOK(sv))
-           RETURN;
-    }
-
-    RETURNOP(cLOGOP->op_other);
-}
-

 PP(pp_caller)
 {
     dSP;
 PP(pp_caller)
 {
     dSP;


@@ -1731,11 +1669,6 @@ PP(pp_reset)
     RETURN;
 }
 
     RETURN;
 }
 

-PP(pp_lineseq)
-{
-    return NORMAL;
-}
-

 /* like pp_nextstate, but used instead when the debugger is active */
 
 PP(pp_dbstate)
 /* like pp_nextstate, but used instead when the debugger is active */
 
 PP(pp_dbstate)


@@ -1774,22 +1707,29 @@ PP(pp_dbstate)
        hasargs = 0;
        SPAGAIN;
 
        hasargs = 0;
        SPAGAIN;
 

-       PUSHBLOCK(cx, CXt_SUB, SP);
-       PUSHSUB_DB(cx);
-       cx->blk_sub.retop = PL_op->op_next;
-       CvDEPTH(cv)++;
-       PAD_SET_CUR(CvPADLIST(cv),1);
-       RETURNOP(CvSTART(cv));
+       if (CvXSUB(cv)) {
+           CvDEPTH(cv)++;
+           PUSHMARK(SP);
+           (void)(*CvXSUB(cv))(aTHX_ cv);
+           CvDEPTH(cv)--;
+           FREETMPS;
+           LEAVE;
+           return NORMAL;
+       }
+       else {
+           PUSHBLOCK(cx, CXt_SUB, SP);
+           PUSHSUB_DB(cx);
+           cx->blk_sub.retop = PL_op->op_next;
+           CvDEPTH(cv)++;
+           SAVECOMPPAD();
+           PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+           RETURNOP(CvSTART(cv));
+       }

     }
     else
        return NORMAL;
 }
 
     }
     else
        return NORMAL;
 }
 

-PP(pp_scope)
-{
-    return NORMAL;
-}
-

 PP(pp_enteriter)
 {
     dVAR; dSP; dMARK;
 PP(pp_enteriter)
 {
     dVAR; dSP; dMARK;


@@ -1842,12 +1782,18 @@ PP(pp_enteriter)
        if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
            dPOPss;
            SV *right = (SV*)cx->blk_loop.iterary;
        if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
            dPOPss;
            SV *right = (SV*)cx->blk_loop.iterary;

+           SvGETMAGIC(sv);
+           SvGETMAGIC(right);

            if (RANGE_IS_NUMERIC(sv,right)) {
                if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
                    (SvOK(right) && SvNV(right) >= IV_MAX))
                    DIE(aTHX_ "Range iterator outside integer range");
                cx->blk_loop.iterix = SvIV(sv);
                cx->blk_loop.itermax = SvIV(right);
            if (RANGE_IS_NUMERIC(sv,right)) {
                if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
                    (SvOK(right) && SvNV(right) >= IV_MAX))
                    DIE(aTHX_ "Range iterator outside integer range");
                cx->blk_loop.iterix = SvIV(sv);
                cx->blk_loop.itermax = SvIV(right);

+#ifdef DEBUGGING
+               /* for correct -Dstv display */
+               cx->blk_oldsp = sp - PL_stack_base;
+#endif

            }
            else {
                cx->blk_loop.iterlval = newSVsv(sv);
            }
            else {
                cx->blk_loop.iterlval = newSVsv(sv);


@@ -1856,8 +1802,8 @@ PP(pp_enteriter)
            }
        }
        else if (PL_op->op_private & OPpITER_REVERSED) {
            }
        }
        else if (PL_op->op_private & OPpITER_REVERSED) {

-           cx->blk_loop.itermax = -1;
-           cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary);
+           cx->blk_loop.itermax = 0;
+           cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary) + 1;

 
        }
     }
 
        }
     }


@@ -1865,8 +1811,8 @@ PP(pp_enteriter)
        cx->blk_loop.iterary = PL_curstack;
        AvFILLp(PL_curstack) = SP - PL_stack_base;
        if (PL_op->op_private & OPpITER_REVERSED) {
        cx->blk_loop.iterary = PL_curstack;
        AvFILLp(PL_curstack) = SP - PL_stack_base;
        if (PL_op->op_private & OPpITER_REVERSED) {

-           cx->blk_loop.itermax = MARK - PL_stack_base;
-           cx->blk_loop.iterix = cx->blk_oldsp;
+           cx->blk_loop.itermax = MARK - PL_stack_base + 1;
+           cx->blk_loop.iterix = cx->blk_oldsp + 1;

        }
        else {
            cx->blk_loop.iterix = MARK - PL_stack_base;
        }
        else {
            cx->blk_loop.iterix = MARK - PL_stack_base;


@@ -1947,24 +1893,33 @@ PP(pp_return)
     SV *sv;
     OP *retop;
 
     SV *sv;
     OP *retop;
 

-    if (PL_curstackinfo->si_type == PERLSI_SORT) {
-       if (cxstack_ix == PL_sortcxix
-           || dopoptosub(cxstack_ix) <= PL_sortcxix)
-       {
-           if (cxstack_ix > PL_sortcxix)
-               dounwind(PL_sortcxix);
-           AvARRAY(PL_curstack)[1] = *SP;
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0) {
+       if (CxMULTICALL(cxstack)) { /* In this case we must be in a
+                                    * sort block, which is a CXt_NULL
+                                    * not a CXt_SUB */
+           dounwind(0);
+           PL_stack_base[1] = *PL_stack_sp;

            PL_stack_sp = PL_stack_base + 1;
            return 0;
        }
            PL_stack_sp = PL_stack_base + 1;
            return 0;
        }

+       else
+           DIE(aTHX_ "Can't return outside a subroutine");

     }
     }

-
-    cxix = dopoptosub(cxstack_ix);
-    if (cxix < 0)
-       DIE(aTHX_ "Can't return outside a subroutine");

     if (cxix < cxstack_ix)
        dounwind(cxix);
 
     if (cxix < cxstack_ix)
        dounwind(cxix);
 

+    if (CxMULTICALL(&cxstack[cxix])) {
+       gimme = cxstack[cxix].blk_gimme;
+       if (gimme == G_VOID)
+           PL_stack_sp = PL_stack_base;
+       else if (gimme == G_SCALAR) {
+           PL_stack_base[1] = *PL_stack_sp;
+           PL_stack_sp = PL_stack_base + 1;
+       }
+       return 0;
+    }
+

     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {
     case CXt_SUB:
     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {
     case CXt_SUB:


@@ -2061,7 +2016,7 @@ PP(pp_last)
     PMOP *newpm;
     SV **mark;
     SV *sv = Nullsv;
     PMOP *newpm;
     SV **mark;
     SV *sv = Nullsv;

-    PERL_UNUSED_VAR(optype);
+

 
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);
 
     if (PL_op->op_flags & OPf_SPECIAL) {
        cxix = dopoptoloop(cxstack_ix);


@@ -2077,7 +2032,6 @@ PP(pp_last)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);

-    PERL_UNUSED_VAR(optype);

     cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
     cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {


@@ -2135,6 +2089,8 @@ PP(pp_last)
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);

+    PERL_UNUSED_VAR(optype);
+    PERL_UNUSED_VAR(gimme);

     return nextop;
 }
 
     return nextop;
 }
 


@@ -2208,7 +2164,6 @@ PP(pp_redo)
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
 {
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
 {

-    OP *kid = Nullop;

     OP **ops = opstack;
     static const char too_deep[] = "Target of goto is too deeply nested";
 
     OP **ops = opstack;
     static const char too_deep[] = "Target of goto is too deeply nested";
 


@@ -2226,6 +2181,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
     }
     *ops = 0;
     if (o->op_flags & OPf_KIDS) {
     }
     *ops = 0;
     if (o->op_flags & OPf_KIDS) {

+       OP *kid;

        /* First try all the kids at this level, since that's likeliest. */
        for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
            if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
        /* First try all the kids at this level, since that's likeliest. */
        for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
            if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&


@@ -2252,12 +2208,6 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
     return 0;
 }
 
     return 0;
 }
 

-PP(pp_dump)
-{
-    return pp_goto();
-    /*NOTREACHED*/
-}
-

 PP(pp_goto)
 {
     dVAR; dSP;
 PP(pp_goto)
 {
     dVAR; dSP;


@@ -2271,7 +2221,7 @@ PP(pp_goto)
     static const char must_have_label[] = "goto must have label";
 
     if (PL_op->op_flags & OPf_STACKED) {
     static const char must_have_label[] = "goto must have label";
 
     if (PL_op->op_flags & OPf_STACKED) {

-       SV *sv = POPs;
+       SV * const sv = POPs;

 
        /* This egregious kludge implements goto &subroutine */
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
 
        /* This egregious kludge implements goto &subroutine */
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {


@@ -2320,6 +2270,8 @@ PP(pp_goto)
                else
                    DIE(aTHX_ "Can't goto subroutine from an eval-block");
            }
                else
                    DIE(aTHX_ "Can't goto subroutine from an eval-block");
            }

+           else if (CxMULTICALL(cx))
+               DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");

            if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
                /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
            if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
                /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;


@@ -2341,8 +2293,7 @@ PP(pp_goto)
                }
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
                }
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */

-               AV* av;
-               av = GvAV(PL_defgv);
+               AV* const av = GvAV(PL_defgv);

                items = AvFILLp(av) + 1;
                EXTEND(SP, items+1); /* @_ could have been extended. */
                Copy(AvARRAY(av), SP + 1, items, SV*);
                items = AvFILLp(av) + 1;
                EXTEND(SP, items+1); /* @_ could have been extended. */
                Copy(AvARRAY(av), SP + 1, items, SV*);


@@ -2416,7 +2367,8 @@ PP(pp_goto)
                        sub_crush_depth(cv);
                    pad_push(padlist, CvDEPTH(cv));
                }
                        sub_crush_depth(cv);
                    pad_push(padlist, CvDEPTH(cv));
                }

-               PAD_SET_CUR(padlist, CvDEPTH(cv));
+               SAVECOMPPAD();
+               PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));

                if (cx->blk_sub.hasargs)
                {
                    AV* av = (AV*)PAD_SVl(0);
                if (cx->blk_sub.hasargs)
                {
                    AV* av = (AV*)PAD_SVl(0);


@@ -2460,12 +2412,12 @@ PP(pp_goto)
                     * We do not care about using sv to call CV;
                     * it's for informational purposes only.
                     */
                     * We do not care about using sv to call CV;
                     * it's for informational purposes only.
                     */

-                   SV *sv = GvSV(PL_DBsub);
+                   SV * const sv = GvSV(PL_DBsub);

                    CV *gotocv;
 
                    save_item(sv);
                    if (PERLDB_SUB_NN) {
                    CV *gotocv;
 
                    save_item(sv);
                    if (PERLDB_SUB_NN) {

-                       int type = SvTYPE(sv);
+                       const int type = SvTYPE(sv);

                        if (type < SVt_PVIV && type != SVt_IV)
                            sv_upgrade(sv, SVt_PVIV);
                        (void)SvIOK_on(sv);
                        if (type < SVt_PVIV && type != SVt_IV)
                            sv_upgrade(sv, SVt_PVIV);
                        (void)SvIOK_on(sv);


@@ -2532,7 +2484,7 @@ PP(pp_goto)
                    gotoprobe = PL_main_root;
                break;
            case CXt_SUB:
                    gotoprobe = PL_main_root;
                break;
            case CXt_SUB:

-               if (CvDEPTH(cx->blk_sub.cv)) {
+               if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) {

                    gotoprobe = CvROOT(cx->blk_sub.cv);
                    break;
                }
                    gotoprobe = CvROOT(cx->blk_sub.cv);
                    break;
                }


@@ -2681,12 +2633,12 @@ STATIC void
 S_save_lines(pTHX_ AV *array, SV *sv)
 {
     const char *s = SvPVX_const(sv);
 S_save_lines(pTHX_ AV *array, SV *sv)
 {
     const char *s = SvPVX_const(sv);

-    const char *send = SvPVX_const(sv) + SvCUR(sv);
+    const char * const send = SvPVX_const(sv) + SvCUR(sv);

     I32 line = 1;
 
     while (s && s < send) {
        const char *t;
     I32 line = 1;
 
     while (s && s < send) {
        const char *t;

-       SV *tmpstr = NEWSV(85,0);
+       SV * const tmpstr = NEWSV(85,0);

 
        sv_upgrade(tmpstr, SVt_PVMG);
        t = strchr(s, '\n');
 
        sv_upgrade(tmpstr, SVt_PVMG);
        t = strchr(s, '\n');


@@ -2764,10 +2716,11 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
 {
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
 {

+    /* FIXME - how much of this code is common with pp_entereval?  */

     dVAR; dSP;                         /* Make POPBLOCK work. */
     PERL_CONTEXT *cx;
     SV **newsp;
     dVAR; dSP;                         /* Make POPBLOCK work. */
     PERL_CONTEXT *cx;
     SV **newsp;

-    I32 gimme = 0;   /* SUSPECT - INITIALZE TO WHAT?  NI-S */
+    I32 gimme = G_VOID;

     I32 optype;
     OP dummy;
     OP *rop;
     I32 optype;
     OP dummy;
     OP *rop;


@@ -2776,6 +2729,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     char *safestr;
     int runtime;
     CV* runcv = Nullcv;        /* initialise to avoid compiler warnings */
     char *safestr;
     int runtime;
     CV* runcv = Nullcv;        /* initialise to avoid compiler warnings */

+    STRLEN len;

 
     ENTER;
     lex_start(sv);
 
     ENTER;
     lex_start(sv);


@@ -2787,14 +2741,16 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
        CopSTASH_set(&PL_compiling, PL_curstash);
     }
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
        CopSTASH_set(&PL_compiling, PL_curstash);
     }
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {

-       SV *sv = sv_newmortal();
+       SV * const sv = sv_newmortal();

        Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]",
                       code, (unsigned long)++PL_evalseq,
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
        tmpbuf = SvPVX(sv);
        Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]",
                       code, (unsigned long)++PL_evalseq,
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
        tmpbuf = SvPVX(sv);

+       len = SvCUR(sv);

     }
     else
     }
     else

-       sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+       len = my_sprintf(tmpbuf, "_<(%.10s_eval %lu)", code,
+                        (unsigned long)++PL_evalseq);

     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);


@@ -2804,8 +2760,8 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */

-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);

     SAVEHINTS();
 #ifdef OP_IN_REGISTER
     PL_opsave = op;
     SAVEHINTS();
 #ifdef OP_IN_REGISTER
     PL_opsave = op;


@@ -2842,6 +2798,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
 #endif
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
 #endif

+    PERL_UNUSED_VAR(newsp);
+    PERL_UNUSED_VAR(optype);
+

     return rop;
 }
 
     return rop;
 }
 


@@ -2853,7 +2812,7 @@ Locate the CV corresponding to the currently executing sub or eval.
 If db_seqp is non_null, skip CVs that are in the DB package and populate
 *db_seqp with the cop sequence number at the point that the DB:: code was
 entered. (allows debuggers to eval in the scope of the breakpoint rather
 If db_seqp is non_null, skip CVs that are in the DB package and populate
 *db_seqp with the cop sequence number at the point that the DB:: code was
 entered. (allows debuggers to eval in the scope of the breakpoint rather

-than in in the scope of the debugger itself).
+than in the scope of the debugger itself).

 
 =cut
 */
 
 =cut
 */


@@ -2897,7 +2856,7 @@ STATIC OP *
 S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 {
     dVAR; dSP;
 S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 {
     dVAR; dSP;

-    OP *saveop = PL_op;
+    OP * const saveop = PL_op;

 
     PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
                  ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
 
     PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
                  ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))


@@ -2945,8 +2904,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        sv_setpvn(ERRSV,"",0);
     if (yyparse() || PL_error_count || !PL_eval_root) {
        SV **newsp;                     /* Used by POPBLOCK. */
        sv_setpvn(ERRSV,"",0);
     if (yyparse() || PL_error_count || !PL_eval_root) {
        SV **newsp;                     /* Used by POPBLOCK. */

-       PERL_CONTEXT *cx = &cxstack[cxstack_ix];
+       PERL_CONTEXT *cx = &cxstack[cxstack_ix];

        I32 optype = 0;                 /* Might be reset by POPEVAL. */
        I32 optype = 0;                 /* Might be reset by POPEVAL. */

+       const char *msg;

 
        PL_op = saveop;
        if (PL_eval_root) {
 
        PL_op = saveop;
        if (PL_eval_root) {


@@ -2960,8 +2920,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        }
        lex_end();
        LEAVE;
        }
        lex_end();
        LEAVE;

+
+       msg = SvPVx_nolen_const(ERRSV);

        if (optype == OP_REQUIRE) {
        if (optype == OP_REQUIRE) {

-           const char* const msg = SvPVx_nolen_const(ERRSV);

            const SV * const nsv = cx->blk_eval.old_namesv;
            (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                           &PL_sv_undef, 0);
            const SV * const nsv = cx->blk_eval.old_namesv;
            (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                           &PL_sv_undef, 0);


@@ -2969,19 +2930,17 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
                *msg ? msg : "Unknown error\n");
        }
        else if (startop) {
                *msg ? msg : "Unknown error\n");
        }
        else if (startop) {

-            const char* msg = SvPVx_nolen_const(ERRSV);
-

            POPBLOCK(cx,PL_curpm);
            POPEVAL(cx);
            Perl_croak(aTHX_ "%sCompilation failed in regexp",
                       (*msg ? msg : "Unknown error\n"));
        }
        else {
            POPBLOCK(cx,PL_curpm);
            POPEVAL(cx);
            Perl_croak(aTHX_ "%sCompilation failed in regexp",
                       (*msg ? msg : "Unknown error\n"));
        }
        else {

-            const char* msg = SvPVx_nolen_const(ERRSV);

            if (!*msg) {
                sv_setpv(ERRSV, "Compilation error");
            }
        }
            if (!*msg) {
                sv_setpv(ERRSV, "Compilation error");
            }
        }

+       PERL_UNUSED_VAR(newsp);

        RETPUSHUNDEF;
     }
     CopLINE_set(&PL_compiling, 0);
        RETPUSHUNDEF;
     }
     CopLINE_set(&PL_compiling, 0);


@@ -3009,7 +2968,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 
     /* Register with debugger: */
     if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {
 
     /* Register with debugger: */
     if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {

-       CV *cv = get_cv("DB::postponed", FALSE);
+       CV * const cv = get_cv("DB::postponed", FALSE);

        if (cv) {
            dSP;
            PUSHMARK(SP);
        if (cv) {
            dSP;
            PUSHMARK(SP);


@@ -3037,14 +2996,14 @@ S_doopen_pm(pTHX_ const char *name, const char *mode)
     PerlIO *fp;
 
     if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
     PerlIO *fp;
 
     if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {

-       SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
+       SV * const pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');

        const char * const pmc = SvPV_nolen_const(pmcsv);
        const char * const pmc = SvPV_nolen_const(pmcsv);

-       Stat_t pmstat;

        Stat_t pmcstat;
        if (PerlLIO_stat(pmc, &pmcstat) < 0) {
            fp = PerlIO_open(name, mode);
        }
        else {
        Stat_t pmcstat;
        if (PerlLIO_stat(pmc, &pmcstat) < 0) {
            fp = PerlIO_open(name, mode);
        }
        else {

+           Stat_t pmstat;

            if (PerlLIO_stat(name, &pmstat) < 0 ||
                pmstat.st_mtime < pmcstat.st_mtime)
            {
            if (PerlLIO_stat(name, &pmstat) < 0 ||
                pmstat.st_mtime < pmcstat.st_mtime)
            {


@@ -3074,7 +3033,6 @@ PP(pp_require)
     STRLEN len;
     const char *tryname = Nullch;
     SV *namesv = Nullsv;
     STRLEN len;
     const char *tryname = Nullch;
     SV *namesv = Nullsv;

-    SV** svp;

     const I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
     int filter_has_file = 0;
     const I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
     int filter_has_file = 0;


@@ -3094,9 +3052,16 @@ PP(pp_require)
        sv = new_version(sv);
        if (!sv_derived_from(PL_patchlevel, "version"))
            (void *)upg_version(PL_patchlevel);
        sv = new_version(sv);
        if (!sv_derived_from(PL_patchlevel, "version"))
            (void *)upg_version(PL_patchlevel);

-       if ( vcmp(sv,PL_patchlevel) > 0 )
-           DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-               vnormal(sv), vnormal(PL_patchlevel));
+       if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
+           if ( vcmp(sv,PL_patchlevel) < 0 )
+               DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
+                   vnormal(sv), vnormal(PL_patchlevel));
+       }
+       else {
+           if ( vcmp(sv,PL_patchlevel) > 0 )
+               DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
+                   vnormal(sv), vnormal(PL_patchlevel));
+       }

 
            RETPUSHYES;
     }
 
            RETPUSHYES;
     }


@@ -3104,12 +3069,14 @@ PP(pp_require)
     if (!(name && len > 0 && *name))
        DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
     if (!(name && len > 0 && *name))
        DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");

-    if (PL_op->op_type == OP_REQUIRE &&
-       (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
-       if (*svp != &PL_sv_undef)
-           RETPUSHYES;
-       else
-           DIE(aTHX_ "Compilation failed in require");
+    if (PL_op->op_type == OP_REQUIRE) {
+       SV ** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+       if ( svp ) {
+           if (*svp != &PL_sv_undef)
+               RETPUSHYES;
+           else
+               DIE(aTHX_ "Compilation failed in require");
+       }

     }
 
     /* prepare to compile file */
     }
 
     /* prepare to compile file */


@@ -3130,7 +3097,7 @@ PP(pp_require)
     }
 #endif
     if (!tryrsfp) {
     }
 #endif
     if (!tryrsfp) {

-       AV *ar = GvAVn(PL_incgv);
+       AV * const ar = GvAVn(PL_incgv);

        I32 i;
 #ifdef VMS
        char *unixname;
        I32 i;
 #ifdef VMS
        char *unixname;


@@ -3276,7 +3243,7 @@ PP(pp_require)
                    sv_setpv(namesv, unixdir);
                    sv_catpv(namesv, unixname);
 #  else
                    sv_setpv(namesv, unixdir);
                    sv_catpv(namesv, unixname);
 #  else

-#    ifdef SYMBIAN
+#    ifdef __SYMBIAN32__

                    if (PL_origfilename[0] &&
                        PL_origfilename[1] == ':' &&
                        !(dir[0] && dir[1] == ':'))
                    if (PL_origfilename[0] &&
                        PL_origfilename[1] == ':' &&
                        !(dir[0] && dir[1] == ':'))


@@ -3312,25 +3279,32 @@ PP(pp_require)
     if (!tryrsfp) {
        if (PL_op->op_type == OP_REQUIRE) {
            const char *msgstr = name;
     if (!tryrsfp) {
        if (PL_op->op_type == OP_REQUIRE) {
            const char *msgstr = name;

-           if (namesv) {                       /* did we lookup @INC? */
-               SV *msg = sv_2mortal(newSVpv(msgstr,0));
-               SV *dirmsgsv = NEWSV(0, 0);
-               AV *ar = GvAVn(PL_incgv);
-               I32 i;
-               sv_catpvn(msg, " in @INC", 8);
-               if (instr(SvPVX_const(msg), ".h "))
-                   sv_catpv(msg, " (change .h to .ph maybe?)");
-               if (instr(SvPVX_const(msg), ".ph "))
-                   sv_catpv(msg, " (did you run h2ph?)");
-               sv_catpv(msg, " (@INC contains:");
-               for (i = 0; i <= AvFILL(ar); i++) {
-                   const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
-                   Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
-                   sv_catsv(msg, dirmsgsv);
-               }
-               sv_catpvn(msg, ")", 1);
-               SvREFCNT_dec(dirmsgsv);
+           if(errno == EMFILE) {
+               SV * const msg = sv_2mortal(newSVpv(msgstr,0));
+               sv_catpv(msg, ":  "); 
+               sv_catpv(msg, Strerror(errno));

                msgstr = SvPV_nolen_const(msg);
                msgstr = SvPV_nolen_const(msg);

+           } else {
+               if (namesv) {                   /* did we lookup @INC? */
+                   SV * const msg = sv_2mortal(newSVpv(msgstr,0));
+                   SV * const dirmsgsv = NEWSV(0, 0);
+                   AV * const ar = GvAVn(PL_incgv);
+                   I32 i;
+                   sv_catpvn(msg, " in @INC", 8);
+                   if (instr(SvPVX_const(msg), ".h "))
+                       sv_catpv(msg, " (change .h to .ph maybe?)");
+                   if (instr(SvPVX_const(msg), ".ph "))
+                       sv_catpv(msg, " (did you run h2ph?)");
+                   sv_catpv(msg, " (@INC contains:");
+                   for (i = 0; i <= AvFILL(ar); i++) {
+                       const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
+                       Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
+                       sv_catsv(msg, dirmsgsv);
+                   }
+                   sv_catpvn(msg, ")", 1);
+                   SvREFCNT_dec(dirmsgsv);
+                   msgstr = SvPV_nolen_const(msg);
+               }    

            }
            DIE(aTHX_ "Can't locate %s", msgstr);
        }
            }
            DIE(aTHX_ "Can't locate %s", msgstr);
        }


@@ -3341,13 +3315,14 @@ PP(pp_require)
        SETERRNO(0, SS_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
        SETERRNO(0, SS_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */

-    len = strlen(name);
+    /* name is never assigned to again, so len is still strlen(name)  */

     /* Check whether a hook in @INC has already filled %INC */
     /* Check whether a hook in @INC has already filled %INC */

-    if (!hook_sv || !(svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
-       (void)hv_store(GvHVn(PL_incgv), name, len,
-                      (hook_sv ? SvREFCNT_inc(hook_sv)
-                               : newSVpv(CopFILE(&PL_compiling), 0)),
-                      0 );
+    if (!hook_sv) {
+       (void)hv_store(GvHVn(PL_incgv), name, len, newSVpv(CopFILE(&PL_compiling),0),0);
+    } else {
+       SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+       if (!svp)
+           (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc(hook_sv), 0 );

     }
 
     ENTER;
     }
 
     ENTER;


@@ -3372,7 +3347,7 @@ PP(pp_require)
     PL_compiling.cop_io = Nullsv;
 
     if (filter_sub || filter_child_proc) {
     PL_compiling.cop_io = Nullsv;
 
     if (filter_sub || filter_child_proc) {

-       SV *datasv = filter_add(run_user_filter, Nullsv);
+       SV * const datasv = filter_add(run_user_filter, Nullsv);

        IoLINES(datasv) = filter_has_file;
        IoFMT_GV(datasv) = (GV *)filter_child_proc;
        IoTOP_GV(datasv) = (GV *)filter_state;
        IoLINES(datasv) = filter_has_file;
        IoFMT_GV(datasv) = (GV *)filter_child_proc;
        IoTOP_GV(datasv) = (GV *)filter_state;


@@ -3401,17 +3376,13 @@ PP(pp_require)
     return op;
 }
 
     return op;
 }
 

-PP(pp_dofile)
-{
-    return pp_require();
-}
-

 PP(pp_entereval)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
     dPOPss;
 PP(pp_entereval)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
     dPOPss;

-    const I32 gimme = GIMME_V, was = PL_sub_generation;
+    const I32 gimme = GIMME_V;
+    const I32 was = PL_sub_generation;

     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
     char *safestr;
     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
     char *safestr;


@@ -3420,7 +3391,7 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
 
     CV* runcv;
     U32 seq;
 

-    if (!SvPV_const(sv,len))
+    if (!SvPV_nolen_const(sv))

        RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
        RETPUSHUNDEF;
     TAINT_PROPER("eval");
 


@@ -3431,14 +3402,15 @@ PP(pp_entereval)
     /* switch to eval mode */
 
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
     /* switch to eval mode */
 
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {

-       SV *sv = sv_newmortal();
+       SV * const sv = sv_newmortal();

        Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
                       (unsigned long)++PL_evalseq,
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
        tmpbuf = SvPVX(sv);
        Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
                       (unsigned long)++PL_evalseq,
                       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
        tmpbuf = SvPVX(sv);

+       len = SvCUR(sv);

     }
     else
     }
     else

-       sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+       len = my_sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);

     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);


@@ -3448,8 +3420,8 @@ PP(pp_entereval)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */

-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);

     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     SAVESPTR(PL_compiling.cop_warnings);
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     SAVESPTR(PL_compiling.cop_warnings);


@@ -3589,6 +3561,7 @@ PP(pp_leavetry)
 
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
 
     POPBLOCK(cx,newpm);
     POPEVAL(cx);

+    PERL_UNUSED_VAR(optype);

 
     TAINT_NOT;
     if (gimme == G_VOID)
 
     TAINT_NOT;
     if (gimme == G_VOID)


@@ -3653,7 +3626,7 @@ S_doparseform(pTHX_ SV *sv)
     s = base;
     base = Nullch;
 
     s = base;
     base = Nullch;
 

-    New(804, fops, maxops, U32);
+    Newx(fops, maxops, U32);

     fpc = fops;
 
     if (s < send) {
     fpc = fops;
 
     if (s < send) {