X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7dfde25db661bada3e1f19c61513f0bac481ca05..50edf520be9fa4c0e7982006bec3a6939b2f61a7:/pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index c9a7f58..1dcca0b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -38,6 +38,8 @@
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
+#define dopoptosub(plop)	dopoptosub_at(cxstack, (plop))
+
 PP(pp_wantarray)
 {
     dVAR;
@@ -75,7 +77,7 @@ PP(pp_regcomp)
     dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     SV *tmpstr;
-    MAGIC *mg = NULL;
+    REGEXP *re = NULL;
 
     /* prevent recompiling under /o and ithreads. */
 #if defined(USE_ITHREADS)
@@ -114,28 +116,33 @@ PP(pp_regcomp)
 
     if (SvROK(tmpstr)) {
 	SV * const sv = SvRV(tmpstr);
-	if(SvMAGICAL(sv))
-	    mg = mg_find(sv, PERL_MAGIC_qr);
+	if (SvTYPE(sv) == SVt_REGEXP)
+	    re = (REGEXP*) sv;
     }
-    if (mg) {
-	regexp * const re = (regexp *)mg->mg_obj;
+    if (re) {
+	re = reg_temp_copy(re);
 	ReREFCNT_dec(PM_GETRE(pm));
-	PM_SETRE(pm, ReREFCNT_inc(re));
+	PM_SETRE(pm, re);
     }
     else {
 	STRLEN len;
-	const char *t = SvPV_const(tmpstr, len);
-	regexp * const re = PM_GETRE(pm);
+	const char *t = SvOK(tmpstr) ? SvPV_const(tmpstr, len) : "";
+	re = PM_GETRE(pm);
+	assert (re != (REGEXP*) &PL_sv_undef);
 
 	/* Check against the last compiled regexp. */
-	if (!re || !re->precomp || re->prelen != (I32)len ||
-	    memNE(re->precomp, t, len))
+	if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != len ||
+	    memNE(RX_PRECOMP(re), t, len))
 	{
-	    const regexp_engine *eng = re ? re->engine : NULL;
-
+	    const regexp_engine *eng = re ? RX_ENGINE(re) : NULL;
+            U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
 	    if (re) {
 	        ReREFCNT_dec(re);
+#ifdef USE_ITHREADS
+		PM_SETRE(pm, (REGEXP*) &PL_sv_undef);
+#else
 		PM_SETRE(pm, NULL);	/* crucial if regcomp aborts */
+#endif
 	    } else if (PL_curcop->cop_hints_hash) {
 	        SV *ptr = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
 				       "regcomp", 7, 0, 0);
@@ -146,50 +153,51 @@ PP(pp_regcomp)
 	    if (PL_op->op_flags & OPf_SPECIAL)
 		PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
 
-	    pm->op_pmflags = pm->op_pmpermflags;	/* reset case sensitivity */
-	    if (DO_UTF8(tmpstr))
-		pm->op_pmdynflags |= PMdf_DYN_UTF8;
-	    else {
-		pm->op_pmdynflags &= ~PMdf_DYN_UTF8;
-		if (pm->op_pmdynflags & PMdf_UTF8)
-		    t = (char*)bytes_to_utf8((U8*)t, &len);
+	    if (DO_UTF8(tmpstr)) {
+		assert (SvUTF8(tmpstr));
+	    } else if (SvUTF8(tmpstr)) {
+		/* Not doing UTF-8, despite what the SV says. Is this only if
+		   we're trapped in use 'bytes'?  */
+		/* Make a copy of the octet sequence, but without the flag on,
+		   as the compiler now honours the SvUTF8 flag on tmpstr.  */
+		STRLEN len;
+		const char *const p = SvPV(tmpstr, len);
+		tmpstr = newSVpvn_flags(p, len, SVs_TEMP);
 	    }
-	    if (eng) 
-	        PM_SETRE(pm, CALLREGCOMP_ENG(eng,(char *)t, (char *)t + len, pm));
-            else
-                PM_SETRE(pm, CALLREGCOMP((char *)t, (char *)t + len, pm));
-                
-	    if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
-		Safefree(t);
+
+ 		if (eng) 
+	        PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
+		else
+	        PM_SETRE(pm, CALLREGCOMP(tmpstr, pm_flags));
+
 	    PL_reginterp_cnt = 0;	/* XXXX Be extra paranoid - needed
 					   inside tie/overload accessors.  */
 	}
     }
+    
+    re = PM_GETRE(pm);
 
 #ifndef INCOMPLETE_TAINTS
     if (PL_tainting) {
 	if (PL_tainted)
-	    pm->op_pmdynflags |= PMdf_TAINTED;
+	    RX_EXTFLAGS(re) |= RXf_TAINTED;
 	else
-	    pm->op_pmdynflags &= ~PMdf_TAINTED;
+	    RX_EXTFLAGS(re) &= ~RXf_TAINTED;
     }
 #endif
 
-    if (!PM_GETRE(pm)->prelen && PL_curpm)
+    if (!RX_PRELEN(PM_GETRE(pm)) && PL_curpm)
 	pm = PL_curpm;
-    else if (PM_GETRE(pm)->extflags & RXf_WHITE)
-	pm->op_pmflags |= PMf_WHITE;
-    else
-	pm->op_pmflags &= ~PMf_WHITE;
 
-    /* XXX runtime compiled output needs to move to the pad */
+
+#if !defined(USE_ITHREADS)
+    /* can't change the optree at runtime either */
+    /* PMf_KEEP is handled differently under threads to avoid these problems */
     if (pm->op_pmflags & PMf_KEEP) {
 	pm->op_private &= ~OPpRUNTIME;	/* no point compiling again */
-#if !defined(USE_ITHREADS)
-	/* XXX can't change the optree at runtime either */
 	cLOGOP->op_first->op_next = PL_op->op_next;
-#endif
     }
+#endif
     RETURN;
 }
 
@@ -226,7 +234,7 @@ PP(pp_substcont)
 	FREETMPS; /* Prevent excess tmp stack */
 
 	/* Are we done */
-	if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
+	if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
 				     s == m, cx->sb_targ, NULL,
 				     ((cx->sb_rflags & REXEC_COPY_STR)
 				      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
@@ -259,7 +267,7 @@ PP(pp_substcont)
 	    SvPV_set(dstr, NULL);
 
 	    TAINT_IF(cx->sb_rxtainted & 1);
-	    PUSHs(sv_2mortal(newSViv(saviters - 1)));
+	    mPUSHi(saviters - 1);
 
 	    (void)SvPOK_only_UTF8(targ);
 	    TAINT_IF(cx->sb_rxtainted);
@@ -272,27 +280,26 @@ PP(pp_substcont)
 	}
 	cx->sb_iters = saviters;
     }
-    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+    if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
 	m = s;
 	s = orig;
-	cx->sb_orig = orig = rx->subbeg;
+	cx->sb_orig = orig = RX_SUBBEG(rx);
 	s = orig + (m - s);
 	cx->sb_strend = s + (cx->sb_strend - m);
     }
-    cx->sb_m = m = rx->startp[0] + orig;
+    cx->sb_m = m = RX_OFFS(rx)[0].start + orig;
     if (m > s) {
 	if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
 	    sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
 	else
 	    sv_catpvn(dstr, s, m-s);
     }
-    cx->sb_s = rx->endp[0] + orig;
+    cx->sb_s = RX_OFFS(rx)[0].end + orig;
     { /* Update the pos() information. */
 	SV * const sv = cx->sb_targ;
 	MAGIC *mg;
 	I32 i;
-	if (SvTYPE(sv) < SVt_PVMG)
-	    SvUPGRADE(sv, SVt_PVMG);
+	SvUPGRADE(sv, SVt_PVMG);
 	if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
 #ifdef PERL_OLD_COPY_ON_WRITE
 	    if (SvIsCOW(sv))
@@ -310,7 +317,7 @@ PP(pp_substcont)
 	(void)ReREFCNT_inc(rx);
     cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
     rxres_save(&cx->sb_rxres, rx);
-    RETURNOP(pm->op_pmreplstart);
+    RETURNOP(pm->op_pmstashstartu.op_pmreplstart);
 }
 
 void
@@ -318,13 +325,15 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
+
+    PERL_ARGS_ASSERT_RXRES_SAVE;
     PERL_UNUSED_CONTEXT;
 
-    if (!p || p[1] < rx->nparens) {
+    if (!p || p[1] < RX_NPARENS(rx)) {
 #ifdef PERL_OLD_COPY_ON_WRITE
-	i = 7 + rx->nparens * 2;
+	i = 7 + RX_NPARENS(rx) * 2;
 #else
-	i = 6 + rx->nparens * 2;
+	i = 6 + RX_NPARENS(rx) * 2;
 #endif
 	if (!p)
 	    Newx(p, i, UV);
@@ -333,21 +342,21 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
 	*rsp = (void*)p;
     }
 
-    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : NULL);
+    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? RX_SUBBEG(rx) : NULL);
     RX_MATCH_COPIED_off(rx);
 
 #ifdef PERL_OLD_COPY_ON_WRITE
-    *p++ = PTR2UV(rx->saved_copy);
-    rx->saved_copy = NULL;
+    *p++ = PTR2UV(RX_SAVED_COPY(rx));
+    RX_SAVED_COPY(rx) = NULL;
 #endif
 
-    *p++ = rx->nparens;
+    *p++ = RX_NPARENS(rx);
 
-    *p++ = PTR2UV(rx->subbeg);
-    *p++ = (UV)rx->sublen;
-    for (i = 0; i <= rx->nparens; ++i) {
-	*p++ = (UV)rx->startp[i];
-	*p++ = (UV)rx->endp[i];
+    *p++ = PTR2UV(RX_SUBBEG(rx));
+    *p++ = (UV)RX_SUBLEN(rx);
+    for (i = 0; i <= RX_NPARENS(rx); ++i) {
+	*p++ = (UV)RX_OFFS(rx)[i].start;
+	*p++ = (UV)RX_OFFS(rx)[i].end;
     }
 }
 
@@ -356,6 +365,8 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
+
+    PERL_ARGS_ASSERT_RXRES_RESTORE;
     PERL_UNUSED_CONTEXT;
 
     RX_MATCH_COPY_FREE(rx);
@@ -363,19 +374,19 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
     *p++ = 0;
 
 #ifdef PERL_OLD_COPY_ON_WRITE
-    if (rx->saved_copy)
-	SvREFCNT_dec (rx->saved_copy);
-    rx->saved_copy = INT2PTR(SV*,*p);
+    if (RX_SAVED_COPY(rx))
+	SvREFCNT_dec (RX_SAVED_COPY(rx));
+    RX_SAVED_COPY(rx) = INT2PTR(SV*,*p);
     *p++ = 0;
 #endif
 
-    rx->nparens = *p++;
+    RX_NPARENS(rx) = *p++;
 
-    rx->subbeg = INT2PTR(char*,*p++);
-    rx->sublen = (I32)(*p++);
-    for (i = 0; i <= rx->nparens; ++i) {
-	rx->startp[i] = (I32)(*p++);
-	rx->endp[i] = (I32)(*p++);
+    RX_SUBBEG(rx) = INT2PTR(char*,*p++);
+    RX_SUBLEN(rx) = (I32)(*p++);
+    for (i = 0; i <= RX_NPARENS(rx); ++i) {
+	RX_OFFS(rx)[i].start = (I32)(*p++);
+	RX_OFFS(rx)[i].end = (I32)(*p++);
     }
 }
 
@@ -383,6 +394,8 @@ void
 Perl_rxres_free(pTHX_ void **rsp)
 {
     UV * const p = (UV*)*rsp;
+
+    PERL_ARGS_ASSERT_RXRES_FREE;
     PERL_UNUSED_CONTEXT;
 
     if (p) {
@@ -932,7 +945,7 @@ PP(pp_grepstart)
     if (PL_stack_base + *PL_markstack_ptr == SP) {
 	(void)POPMARK;
 	if (GIMME_V == G_SCALAR)
-	    XPUSHs(sv_2mortal(newSViv(0)));
+	    mXPUSHi(0);
 	RETURNOP(PL_op->op_next->op_next);
     }
     PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
@@ -1217,14 +1230,17 @@ PP(pp_flop)
 
 static const char * const context_name[] = {
     "pseudo-block",
+    "when",
+    NULL, /* CXt_BLOCK never actually needs "block" */
+    "given",
+    NULL, /* CXt_LOOP_FOR never actually needs "loop" */
+    NULL, /* CXt_LOOP_PLAIN never actually needs "loop" */
+    NULL, /* CXt_LOOP_LAZYSV never actually needs "loop" */
+    NULL, /* CXt_LOOP_LAZYIV never actually needs "loop" */
     "subroutine",
+    "format",
     "eval",
-    "loop",
     "substitution",
-    "block",
-    "format",
-    "given",
-    "when"
 };
 
 STATIC I32
@@ -1233,6 +1249,8 @@ S_dopoptolabel(pTHX_ const char *label)
     dVAR;
     register I32 i;
 
+    PERL_ARGS_ASSERT_DOPOPTOLABEL;
+
     for (i = cxstack_ix; i >= 0; i--) {
 	register const PERL_CONTEXT * const cx = &cxstack[i];
 	switch (CxTYPE(cx)) {
@@ -1249,10 +1267,13 @@ S_dopoptolabel(pTHX_ const char *label)
 	    if (CxTYPE(cx) == CXt_NULL)
 		return -1;
 	    break;
-	case CXt_LOOP:
-	    if ( !cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) {
+	case CXt_LOOP_LAZYIV:
+	case CXt_LOOP_LAZYSV:
+	case CXt_LOOP_FOR:
+	case CXt_LOOP_PLAIN:
+	    if ( !CxLABEL(cx) || strNE(label, CxLABEL(cx)) ) {
 		DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
-			(long)i, cx->blk_loop.label));
+			(long)i, CxLABEL(cx)));
 		continue;
 	    }
 	    DEBUG_l( Perl_deb(aTHX_ "(Found label #%ld %s)\n", (long)i, label));
@@ -1301,24 +1322,20 @@ Perl_is_lvalue_sub(pTHX)
     const I32 cxix = dopoptosub(cxstack_ix);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
-    if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
-	return cxstack[cxix].blk_sub.lval;
+    if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
+	return CxLVAL(cxstack + cxix);
     else
 	return 0;
 }
 
 STATIC I32
-S_dopoptosub(pTHX_ I32 startingblock)
-{
-    dVAR;
-    return dopoptosub_at(cxstack, startingblock);
-}
-
-STATIC I32
 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
 {
     dVAR;
     I32 i;
+
+    PERL_ARGS_ASSERT_DOPOPTOSUB_AT;
+
     for (i = startingblock; i >= 0; i--) {
 	register const PERL_CONTEXT * const cx = &cxstk[i];
 	switch (CxTYPE(cx)) {
@@ -1371,7 +1388,10 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 	    if ((CxTYPE(cx)) == CXt_NULL)
 		return -1;
 	    break;
-	case CXt_LOOP:
+	case CXt_LOOP_LAZYIV:
+	case CXt_LOOP_LAZYSV:
+	case CXt_LOOP_FOR:
+	case CXt_LOOP_PLAIN:
 	    DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
 	    return i;
 	}
@@ -1392,7 +1412,12 @@ S_dopoptogiven(pTHX_ I32 startingblock)
 	case CXt_GIVEN:
 	    DEBUG_l( Perl_deb(aTHX_ "(Found given #%ld)\n", (long)i));
 	    return i;
-	case CXt_LOOP:
+	case CXt_LOOP_PLAIN:
+	    assert(!CxFOREACHDEF(cx));
+	    break;
+	case CXt_LOOP_LAZYIV:
+	case CXt_LOOP_LAZYSV:
+	case CXt_LOOP_FOR:
 	    if (CxFOREACHDEF(cx)) {
 		DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
 		return i;
@@ -1443,7 +1468,10 @@ Perl_dounwind(pTHX_ I32 cxix)
 	case CXt_EVAL:
 	    POPEVAL(cx);
 	    break;
-	case CXt_LOOP:
+	case CXt_LOOP_LAZYIV:
+	case CXt_LOOP_LAZYSV:
+	case CXt_LOOP_FOR:
+	case CXt_LOOP_PLAIN:
 	    POPLOOP(cx);
 	    break;
 	case CXt_NULL:
@@ -1461,13 +1489,17 @@ void
 Perl_qerror(pTHX_ SV *err)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_QERROR;
+
     if (PL_in_eval)
 	sv_catsv(ERRSV, err);
     else if (PL_errors)
 	sv_catsv(PL_errors, err);
     else
 	Perl_warn(aTHX_ "%"SVf, SVfARG(err));
-    ++PL_error_count;
+    if (PL_parser)
+	++PL_parser->error_count;
 }
 
 OP *
@@ -1641,9 +1673,9 @@ PP(pp_caller)
     if (!stashname)
 	PUSHs(&PL_sv_undef);
     else
-	PUSHs(sv_2mortal(newSVpv(stashname, 0)));
-    PUSHs(sv_2mortal(newSVpv(OutCopFILE(cx->blk_oldcop), 0)));
-    PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
+	mPUSHs(newSVpv(stashname, 0));
+    mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0));
+    mPUSHi((I32)CopLINE(cx->blk_oldcop));
     if (!MAXARG)
 	RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
@@ -1652,32 +1684,32 @@ PP(pp_caller)
 	if (isGV(cvgv)) {
 	    SV * const sv = newSV(0);
 	    gv_efullname3(sv, cvgv, NULL);
-	    PUSHs(sv_2mortal(sv));
-	    PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+	    mPUSHs(sv);
+	    PUSHs(boolSV(CxHASARGS(cx)));
 	}
 	else {
-	    PUSHs(sv_2mortal(newSVpvs("(unknown)")));
-	    PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+	    PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP));
+	    PUSHs(boolSV(CxHASARGS(cx)));
 	}
     }
     else {
-	PUSHs(sv_2mortal(newSVpvs("(eval)")));
-	PUSHs(sv_2mortal(newSViv(0)));
+	PUSHs(newSVpvs_flags("(eval)", SVs_TEMP));
+	mPUSHi(0);
     }
     gimme = (I32)cx->blk_gimme;
     if (gimme == G_VOID)
 	PUSHs(&PL_sv_undef);
     else
-	PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
+	PUSHs(boolSV((gimme & G_WANT) == G_ARRAY));
     if (CxTYPE(cx) == CXt_EVAL) {
 	/* eval STRING */
-	if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
+	if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) {
 	    PUSHs(cx->blk_eval.cur_text);
 	    PUSHs(&PL_sv_no);
 	}
 	/* require */
 	else if (cx->blk_eval.old_namesv) {
-	    PUSHs(sv_2mortal(newSVsv(cx->blk_eval.old_namesv)));
+	    mPUSHs(newSVsv(cx->blk_eval.old_namesv));
 	    PUSHs(&PL_sv_yes);
 	}
 	/* eval BLOCK (try blocks have old_namesv == 0) */
@@ -1690,7 +1722,7 @@ PP(pp_caller)
 	PUSHs(&PL_sv_undef);
 	PUSHs(&PL_sv_undef);
     }
-    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
+    if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)
 	&& CopSTASH_eq(PL_curcop, PL_debstash))
     {
 	AV * const ary = cx->blk_sub.argarray;
@@ -1711,7 +1743,7 @@ PP(pp_caller)
     /* XXX only hints propagated via op_private are currently
      * visible (others are not easily accessible, since they
      * use the global PL_hints) */
-    PUSHs(sv_2mortal(newSViv(CopHINTS_get(cx->blk_oldcop))));
+    mPUSHi(CopHINTS_get(cx->blk_oldcop));
     {
 	SV * mask ;
 	STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ;
@@ -1734,7 +1766,7 @@ PP(pp_caller)
 	}
         else
             mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]);
-        PUSHs(sv_2mortal(mask));
+        mPUSHs(mask);
     }
 
     PUSHs(cx->blk_oldcop->cop_hints_hash ?
@@ -1820,9 +1852,9 @@ PP(pp_enteriter)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     SV **svp;
-    U16 cxtype = CXt_LOOP | CXp_FOREACH;
+    U8 cxtype = CXt_LOOP_FOR;
 #ifdef USE_ITHREADS
-    void *iterdata;
+    PAD *iterdata;
 #endif
 
     ENTER;
@@ -1834,13 +1866,11 @@ PP(pp_enteriter)
 	    SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
 		    SVs_PADSTALE, SVs_PADSTALE);
 	}
+	SAVEPADSVANDMORTALIZE(PL_op->op_targ);
 #ifndef USE_ITHREADS
 	svp = &PAD_SVl(PL_op->op_targ);		/* "my" variable */
-	SAVESPTR(*svp);
 #else
-	SAVEPADSV(PL_op->op_targ);
-	iterdata = INT2PTR(void*, PL_op->op_targ);
-	cxtype |= CXp_PADVAR;
+	iterdata = NULL;
 #endif
     }
     else {
@@ -1849,7 +1879,7 @@ PP(pp_enteriter)
 	SAVEGENERICSV(*svp);
 	*svp = newSV(0);
 #ifdef USE_ITHREADS
-	iterdata = (void*)gv;
+	iterdata = (PAD*)gv;
 #endif
     }
 
@@ -1860,49 +1890,87 @@ PP(pp_enteriter)
 
     PUSHBLOCK(cx, cxtype, SP);
 #ifdef USE_ITHREADS
-    PUSHLOOP(cx, iterdata, MARK);
+    PUSHLOOP_FOR(cx, iterdata, MARK, PL_op->op_targ);
 #else
-    PUSHLOOP(cx, svp, MARK);
+    PUSHLOOP_FOR(cx, svp, MARK, 0);
 #endif
     if (PL_op->op_flags & OPf_STACKED) {
-	cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
-	if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
+	SV *maybe_ary = POPs;
+	if (SvTYPE(maybe_ary) != SVt_PVAV) {
 	    dPOPss;
-	    SV * const right = (SV*)cx->blk_loop.iterary;
+	    SV * const right = maybe_ary;
 	    SvGETMAGIC(sv);
 	    SvGETMAGIC(right);
 	    if (RANGE_IS_NUMERIC(sv,right)) {
-		if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
-		    (SvOK(right) && SvNV(right) >= IV_MAX))
+		cx->cx_type &= ~CXTYPEMASK;
+		cx->cx_type |= CXt_LOOP_LAZYIV;
+		/* Make sure that no-one re-orders cop.h and breaks our
+		   assumptions */
+		assert(CxTYPE(cx) == CXt_LOOP_LAZYIV);
+#ifdef NV_PRESERVES_UV
+		if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
+				  (SvNV(sv) > (NV)IV_MAX)))
+			||
+		    (SvOK(right) && ((SvNV(right) > (NV)IV_MAX) ||
+				     (SvNV(right) < (NV)IV_MIN))))
+#else
+		if ((SvOK(sv) && ((SvNV(sv) <= (NV)IV_MIN)
+				  ||
+		                  ((SvNV(sv) > 0) &&
+					((SvUV(sv) > (UV)IV_MAX) ||
+					 (SvNV(sv) > (NV)UV_MAX)))))
+			||
+		    (SvOK(right) && ((SvNV(right) <= (NV)IV_MIN)
+				     ||
+				     ((SvNV(right) > 0) &&
+					((SvUV(right) > (UV)IV_MAX) ||
+					 (SvNV(right) > (NV)UV_MAX))))))
+#endif
 		    DIE(aTHX_ "Range iterator outside integer range");
-		cx->blk_loop.iterix = SvIV(sv);
-		cx->blk_loop.itermax = SvIV(right);
+		cx->blk_loop.state_u.lazyiv.cur = SvIV(sv);
+		cx->blk_loop.state_u.lazyiv.end = SvIV(right);
 #ifdef DEBUGGING
 		/* for correct -Dstv display */
 		cx->blk_oldsp = sp - PL_stack_base;
 #endif
 	    }
 	    else {
-		cx->blk_loop.iterlval = newSVsv(sv);
-		(void) SvPV_force_nolen(cx->blk_loop.iterlval);
+		cx->cx_type &= ~CXTYPEMASK;
+		cx->cx_type |= CXt_LOOP_LAZYSV;
+		/* Make sure that no-one re-orders cop.h and breaks our
+		   assumptions */
+		assert(CxTYPE(cx) == CXt_LOOP_LAZYSV);
+		cx->blk_loop.state_u.lazysv.cur = newSVsv(sv);
+		cx->blk_loop.state_u.lazysv.end = right;
+		SvREFCNT_inc(right);
+		(void) SvPV_force_nolen(cx->blk_loop.state_u.lazysv.cur);
+		/* This will do the upgrade to SVt_PV, and warn if the value
+		   is uninitialised.  */
 		(void) SvPV_nolen_const(right);
+		/* Doing this avoids a check every time in pp_iter in pp_hot.c
+		   to replace !SvOK() with a pointer to "".  */
+		if (!SvOK(right)) {
+		    SvREFCNT_dec(right);
+		    cx->blk_loop.state_u.lazysv.end = &PL_sv_no;
+		}
 	    }
 	}
-	else if (PL_op->op_private & OPpITER_REVERSED) {
-	    cx->blk_loop.itermax = 0;
-	    cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary) + 1;
-
+	else /* SvTYPE(maybe_ary) == SVt_PVAV */ {
+	    cx->blk_loop.state_u.ary.ary = (AV*)maybe_ary;
+	    SvREFCNT_inc(maybe_ary);
+	    cx->blk_loop.state_u.ary.ix =
+		(PL_op->op_private & OPpITER_REVERSED) ?
+		AvFILL(cx->blk_loop.state_u.ary.ary) + 1 :
+		-1;
 	}
     }
-    else {
-	cx->blk_loop.iterary = PL_curstack;
-	AvFILLp(PL_curstack) = SP - PL_stack_base;
+    else { /* iterating over items on the stack */
+	cx->blk_loop.state_u.ary.ary = NULL; /* means to use the stack */
 	if (PL_op->op_private & OPpITER_REVERSED) {
-	    cx->blk_loop.itermax = MARK - PL_stack_base + 1;
-	    cx->blk_loop.iterix = cx->blk_oldsp + 1;
+	    cx->blk_loop.state_u.ary.ix = cx->blk_oldsp + 1;
 	}
 	else {
-	    cx->blk_loop.iterix = MARK - PL_stack_base;
+	    cx->blk_loop.state_u.ary.ix = MARK - PL_stack_base;
 	}
     }
 
@@ -1919,8 +1987,8 @@ PP(pp_enterloop)
     SAVETMPS;
     ENTER;
 
-    PUSHBLOCK(cx, CXt_LOOP, SP);
-    PUSHLOOP(cx, 0, SP);
+    PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
+    PUSHLOOP_PLAIN(cx, SP);
 
     RETURN;
 }
@@ -1935,7 +2003,7 @@ PP(pp_leaveloop)
     SV **mark;
 
     POPBLOCK(cx,newpm);
-    assert(CxTYPE(cx) == CXt_LOOP);
+    assert(CxTYPE_is_LOOP(cx));
     mark = newsp;
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
@@ -2122,8 +2190,11 @@ PP(pp_last)
     cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
-    case CXt_LOOP:
-	pop2 = CXt_LOOP;
+    case CXt_LOOP_LAZYIV:
+    case CXt_LOOP_LAZYSV:
+    case CXt_LOOP_FOR:
+    case CXt_LOOP_PLAIN:
+	pop2 = CxTYPE(cx);
 	newsp = PL_stack_base + cx->blk_loop.resetsp;
 	nextop = cx->blk_loop.my_op->op_lastop->op_next;
 	break;
@@ -2165,7 +2236,10 @@ PP(pp_last)
     cxstack_ix--;
     /* Stack values are safe: */
     switch (pop2) {
-    case CXt_LOOP:
+    case CXt_LOOP_LAZYIV:
+    case CXt_LOOP_PLAIN:
+    case CXt_LOOP_LAZYSV:
+    case CXt_LOOP_FOR:
 	POPLOOP(cx);	/* release loop vars ... */
 	LEAVE;
 	break;
@@ -2255,6 +2329,8 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
     OP **ops = opstack;
     static const char too_deep[] = "Target of goto is too deeply nested";
 
+    PERL_ARGS_ASSERT_DOFINDLABEL;
+
     if (ops >= oplimit)
 	Perl_croak(aTHX_ too_deep);
     if (o->op_type == OP_LEAVE ||
@@ -2360,7 +2436,7 @@ PP(pp_goto)
 	    }
 	    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) {
+	    if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
 		/* put @_ back onto stack */
 		AV* av = cx->blk_sub.argarray;
 
@@ -2419,10 +2495,9 @@ PP(pp_goto)
 	    else {
 		AV* const padlist = CvPADLIST(cv);
 		if (CxTYPE(cx) == CXt_EVAL) {
-		    PL_in_eval = cx->blk_eval.old_in_eval;
+		    PL_in_eval = CxOLD_IN_EVAL(cx);
 		    PL_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);
@@ -2431,13 +2506,13 @@ PP(pp_goto)
 		if (CvDEPTH(cv) < 2)
 		    SvREFCNT_inc_simple_void_NN(cv);
 		else {
-		    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
+		    if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION))
 			sub_crush_depth(cv);
 		    pad_push(padlist, CvDEPTH(cv));
 		}
 		SAVECOMPPAD();
 		PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
-		if (cx->blk_sub.hasargs)
+		if (CxHASARGS(cx))
 		{
 		    AV* const av = (AV*)PAD_SVl(0);
 
@@ -2524,7 +2599,10 @@ PP(pp_goto)
 		    break;
                 }
                 /* else fall through */
-	    case CXt_LOOP:
+	    case CXt_LOOP_LAZYIV:
+	    case CXt_LOOP_LAZYSV:
+	    case CXt_LOOP_FOR:
+	    case CXt_LOOP_PLAIN:
 		gotoprobe = cx->blk_oldcop->op_sibling;
 		break;
 	    case CXt_SUBST:
@@ -2656,6 +2734,8 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     const char * const send = SvPVX_const(sv) + SvCUR(sv);
     I32 line = 1;
 
+    PERL_ARGS_ASSERT_SAVE_LINES;
+
     while (s && s < send) {
 	const char *t;
 	SV * const tmpstr = newSV_type(SVt_PVMG);
@@ -2672,14 +2752,6 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     }
 }
 
-STATIC void
-S_docatch_body(pTHX)
-{
-    dVAR;
-    CALLRUNOPS(aTHX);
-    return;
-}
-
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
@@ -2700,7 +2772,7 @@ S_docatch(pTHX_ OP *o)
 	assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
 	cxstack[cxstack_ix].blk_eval.cur_top_env = PL_top_env;
  redo_body:
-	docatch_body();
+	CALLRUNOPS(aTHX);
 	break;
     case 3:
 	/* die caught by an inner eval - continue inner loop */
@@ -2744,7 +2816,6 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     I32 gimme = G_VOID;
     I32 optype;
     OP dummy;
-    OP *rop;
     char tbuf[TYPE_DIGITS(long) + 12 + 10];
     char *tmpbuf = tbuf;
     char *safestr;
@@ -2752,8 +2823,10 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     CV* runcv = NULL;	/* initialise to avoid compiler warnings */
     STRLEN len;
 
+    PERL_ARGS_ASSERT_SV_COMPILE_2OP;
+
     ENTER;
-    lex_start(sv);
+    lex_start(sv, NULL, FALSE);
     SAVETMPS;
     /* switch to eval mode */
 
@@ -2799,12 +2872,12 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;			/* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
-    PUSHEVAL(cx, 0, NULL);
+    PUSHEVAL(cx, 0);
 
     if (runtime)
-	rop = doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
+	(void) doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
     else
-	rop = doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
+	(void) doeval(G_SCALAR, startop, PL_compcv, PL_cop_seqmax);
     POPBLOCK(cx,PL_curpm);
     POPEVAL(cx);
 
@@ -2822,7 +2895,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     PERL_UNUSED_VAR(newsp);
     PERL_UNUSED_VAR(optype);
 
-    return rop;
+    return PL_eval_start;
 }
 
 
@@ -2871,9 +2944,12 @@ Perl_find_runcv(pTHX_ U32 *db_seqp)
  * In the last case, startop is non-null, and contains the address of
  * a pointer that should be set to the just-compiled code.
  * outside is the lexically enclosing CV (if any) that invoked us.
+ * Returns a bool indicating whether the compile was successful; if so,
+ * PL_eval_start contains the first op of the compiled ocde; otherwise,
+ * pushes undef (also croaks if startop != NULL).
  */
 
-STATIC OP *
+STATIC bool
 S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 {
     dVAR; dSP;
@@ -2916,24 +2992,22 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     SAVESPTR(PL_unitcheckav);
     PL_unitcheckav = newAV();
     SAVEFREESV(PL_unitcheckav);
-    SAVEI32(PL_error_count);
 
 #ifdef PERL_MAD
-    SAVEI32(PL_madskills);
+    SAVEBOOL(PL_madskills);
     PL_madskills = 0;
 #endif
 
     /* try to compile it */
 
     PL_eval_root = NULL;
-    PL_error_count = 0;
     PL_curcop = &PL_compiling;
     CopARYBASE_set(PL_curcop, 0);
     if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
 	PL_in_eval |= EVAL_KEEPERR;
     else
 	sv_setpvn(ERRSV,"",0);
-    if (yyparse() || PL_error_count || !PL_eval_root) {
+    if (yyparse() || PL_parser->error_count || !PL_eval_root) {
 	SV **newsp;			/* Used by POPBLOCK. */
 	PERL_CONTEXT *cx = &cxstack[cxstack_ix];
 	I32 optype = 0;			/* Might be reset by POPEVAL. */
@@ -2957,8 +3031,8 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	    const SV * const nsv = cx->blk_eval.old_namesv;
 	    (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                           &PL_sv_undef, 0);
-	    DIE(aTHX_ "%sCompilation failed in require",
-		*msg ? msg : "Unknown error\n");
+	    Perl_croak(aTHX_ "%sCompilation failed in require",
+		       *msg ? msg : "Unknown error\n");
 	}
 	else if (startop) {
 	    POPBLOCK(cx,PL_curpm);
@@ -2972,7 +3046,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	    }
 	}
 	PERL_UNUSED_VAR(newsp);
-	RETPUSHUNDEF;
+	PUSHs(&PL_sv_undef);
+	PUTBACK;
+	return FALSE;
     }
     CopLINE_set(&PL_compiling, 0);
     if (startop) {
@@ -2988,9 +3064,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	    && cLISTOPx(cUNOPx(PL_eval_root)->op_first)->op_last->op_type
 	    == OP_REQUIRE)
 	scalar(PL_eval_root);
-    else if (gimme & G_VOID)
+    else if ((gimme & G_WANT) == G_VOID)
 	scalarvoid(PL_eval_root);
-    else if (gimme & G_ARRAY)
+    else if ((gimme & G_WANT) == G_ARRAY)
 	list(PL_eval_root);
     else
 	scalar(PL_eval_root);
@@ -3017,51 +3093,60 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     CvDEPTH(PL_compcv) = 1;
     SP = PL_stack_base + POPMARK;		/* pop original mark */
     PL_op = saveop;			/* The caller may need it. */
-    PL_lex_state = LEX_NOTPARSING;	/* $^S needs this. */
+    PL_parser->lex_state = LEX_NOTPARSING;	/* $^S needs this. */
 
-    RETURNOP(PL_eval_start);
+    PUTBACK;
+    return TRUE;
 }
 
 STATIC PerlIO *
-S_check_type_and_open(pTHX_ const char *name, const char *mode)
+S_check_type_and_open(pTHX_ const char *name)
 {
     Stat_t st;
     const int st_rc = PerlLIO_stat(name, &st);
 
+    PERL_ARGS_ASSERT_CHECK_TYPE_AND_OPEN;
+
     if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
 	return NULL;
     }
 
-    return PerlIO_open(name, mode);
+    return PerlIO_open(name, PERL_SCRIPT_MODE);
 }
 
+#ifndef PERL_DISABLE_PMC
 STATIC PerlIO *
-S_doopen_pm(pTHX_ const char *name, const char *mode)
+S_doopen_pm(pTHX_ const char *name, const STRLEN namelen)
 {
-#ifndef PERL_DISABLE_PMC
-    const STRLEN namelen = strlen(name);
     PerlIO *fp;
 
-    if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
-	SV * const pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
-	const char * const pmc = SvPV_nolen_const(pmcsv);
+    PERL_ARGS_ASSERT_DOOPEN_PM;
+
+    if (namelen > 3 && memEQs(name + namelen - 3, 3, ".pm")) {
+	SV *const pmcsv = newSV(namelen + 2);
+	char *const pmc = SvPVX(pmcsv);
 	Stat_t pmcstat;
+
+	memcpy(pmc, name, namelen);
+	pmc[namelen] = 'c';
+	pmc[namelen + 1] = '\0';
+
 	if (PerlLIO_stat(pmc, &pmcstat) < 0) {
-	    fp = check_type_and_open(name, mode);
+	    fp = check_type_and_open(name);
 	}
 	else {
-	    fp = check_type_and_open(pmc, mode);
+	    fp = check_type_and_open(pmc);
 	}
 	SvREFCNT_dec(pmcsv);
     }
     else {
-	fp = check_type_and_open(name, mode);
+	fp = check_type_and_open(name);
     }
     return fp;
+}
 #else
-    return check_type_and_open(name, mode);
+#  define doopen_pm(name, namelen) check_type_and_open(name)
 #endif /* !PERL_DISABLE_PMC */
-}
 
 PP(pp_require)
 {
@@ -3070,6 +3155,11 @@ PP(pp_require)
     SV *sv;
     const char *name;
     STRLEN len;
+    char * unixname;
+    STRLEN unixlen;
+#ifdef VMS
+    int vms_unixname = 0;
+#endif
     const char *tryname = NULL;
     SV *namesv = NULL;
     const I32 gimme = GIMME_V;
@@ -3084,28 +3174,60 @@ PP(pp_require)
 
     sv = POPs;
     if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
-	if ( SvVOK(sv) && ckWARN(WARN_PORTABLE) )	/* require v5.6.1 */
-		Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
-                        "v-string in use/require non-portable");
-
 	sv = new_version(sv);
 	if (!sv_derived_from(PL_patchlevel, "version"))
-	    upg_version(PL_patchlevel);
+	    upg_version(PL_patchlevel, TRUE);
 	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",
 		    SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
 	}
 	else {
-	    if ( vcmp(sv,PL_patchlevel) > 0 )
-		DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-		    SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
+	    if ( vcmp(sv,PL_patchlevel) > 0 ) {
+		I32 first = 0;
+		AV *lav;
+		SV * const req = SvRV(sv);
+		SV * const pv = *hv_fetchs((HV*)req, "original", FALSE);
+
+		/* get the left hand term */
+		lav = (AV *)SvRV(*hv_fetchs((HV*)req, "version", FALSE));
+
+		first  = SvIV(*av_fetch(lav,0,0));
+		if (   first > (int)PERL_REVISION    /* probably 'use 6.0' */
+		    || hv_exists((HV*)req, "qv", 2 ) /* qv style */
+		    || av_len(lav) > 1               /* FP with > 3 digits */
+		    || strstr(SvPVX(pv),".0")        /* FP with leading 0 */
+		   ) {
+		    DIE(aTHX_ "Perl %"SVf" required--this is only "
+		    	"%"SVf", stopped", SVfARG(vnormal(req)),
+			SVfARG(vnormal(PL_patchlevel)));
+		}
+		else { /* probably 'use 5.10' or 'use 5.8' */
+		    SV * hintsv = newSV(0);
+		    I32 second = 0;
+
+		    if (av_len(lav)>=1) 
+			second = SvIV(*av_fetch(lav,1,0));
+
+		    second /= second >= 600  ? 100 : 10;
+		    hintsv = Perl_newSVpvf(aTHX_ "v%d.%d.%d",
+		    	(int)first, (int)second,0);
+		    upg_version(hintsv, TRUE);
+
+		    DIE(aTHX_ "Perl %"SVf" required (did you mean %"SVf"?)"
+		    	"--this is only %"SVf", stopped",
+			SVfARG(vnormal(req)),
+			SVfARG(vnormal(hintsv)),
+			SVfARG(vnormal(PL_patchlevel)));
+		}
+	    }
 	}
 
-	/* If we request a version >= 5.9.5, load feature.pm with the
-	 * feature bundle that corresponds to the required version.
-	 * We do this only with use, not require. */
-	if (PL_compcv && vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005)))) >= 0) {
+        /* We do this only with use, not require. */
+	if (PL_compcv &&
+	  /* If we request a version >= 5.9.5, load feature.pm with the
+	   * feature bundle that corresponds to the required version. */
+		vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
 	    SV *const importsv = vnormal(sv);
 	    *SvPVX_mutable(importsv) = ':';
 	    ENTER;
@@ -3119,13 +3241,37 @@ PP(pp_require)
     if (!(name && len > 0 && *name))
 	DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
+
+
+#ifdef VMS
+    /* The key in the %ENV hash is in the syntax of file passed as the argument
+     * usually this is in UNIX format, but sometimes in VMS format, which
+     * can result in a module being pulled in more than once.
+     * To prevent this, the key must be stored in UNIX format if the VMS
+     * name can be translated to UNIX.
+     */
+    if ((unixname = tounixspec(name, NULL)) != NULL) {
+	unixlen = strlen(unixname);
+	vms_unixname = 1;
+    }
+    else
+#endif
+    {
+        /* if not VMS or VMS name can not be translated to UNIX, pass it
+	 * through.
+	 */
+	unixname = (char *) name;
+	unixlen = len;
+    }
     if (PL_op->op_type == OP_REQUIRE) {
-	SV * const * const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+	SV * const * const svp = hv_fetch(GvHVn(PL_incgv),
+					  unixname, unixlen, 0);
 	if ( svp ) {
 	    if (*svp != &PL_sv_undef)
 		RETPUSHYES;
 	    else
-		DIE(aTHX_ "Compilation failed in require");
+		DIE(aTHX_ "Attempt to reload %s aborted.\n"
+			    "Compilation failed in require", unixname);
 	}
     }
 
@@ -3133,7 +3279,7 @@ PP(pp_require)
 
     if (path_is_absolute(name)) {
 	tryname = name;
-	tryrsfp = doopen_pm(name,PERL_SCRIPT_MODE);
+	tryrsfp = doopen_pm(name, len);
     }
 #ifdef MACOS_TRADITIONAL
     if (!tryrsfp) {
@@ -3142,7 +3288,7 @@ PP(pp_require)
 	MacPerl_CanonDir(name, newname, 1);
 	if (path_is_absolute(newname)) {
 	    tryname = newname;
-	    tryrsfp = doopen_pm(newname,PERL_SCRIPT_MODE);
+	    tryrsfp = doopen_pm(newname, strlen(newname));
 	}
     }
 #endif
@@ -3150,11 +3296,10 @@ PP(pp_require)
 	AV * const ar = GvAVn(PL_incgv);
 	I32 i;
 #ifdef VMS
-	char *unixname;
-	if ((unixname = tounixspec(name, NULL)) != NULL)
+	if (vms_unixname)
 #endif
 	{
-	    namesv = newSV(0);
+	    namesv = newSV_type(SVt_PV);
 	    for (i = 0; i <= AvFILL(ar); i++) {
 		SV * const dirsv = *av_fetch(ar, i, TRUE);
 
@@ -3284,7 +3429,16 @@ PP(pp_require)
 			|| (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
 #endif
 		  ) {
-		    const char *dir = SvPVx_nolen_const(dirsv);
+		    const char *dir;
+		    STRLEN dirlen;
+
+		    if (SvOK(dirsv)) {
+			dir = SvPV_const(dirsv, dirlen);
+		    } else {
+			dir = "";
+			dirlen = 0;
+		    }
+
 #ifdef MACOS_TRADITIONAL
 		    char buf1[256];
 		    char buf2[256];
@@ -3312,13 +3466,32 @@ PP(pp_require)
 				       "%s\\%s",
 				       dir, name);
 #    else
-		    Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
+		    /* The equivalent of		    
+		       Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
+		       but without the need to parse the format string, or
+		       call strlen on either pointer, and with the correct
+		       allocation up front.  */
+		    {
+			char *tmp = SvGROW(namesv, dirlen + len + 2);
+
+			memcpy(tmp, dir, dirlen);
+			tmp +=dirlen;
+			*tmp++ = '/';
+			/* name came from an SV, so it will have a '\0' at the
+			   end that we can copy as part of this memcpy().  */
+			memcpy(tmp, name, len + 1);
+
+			SvCUR_set(namesv, dirlen + len + 1);
+
+			/* Don't even actually have to turn SvPOK_on() as we
+			   access it directly with SvPVX() below.  */
+		    }
 #    endif
 #  endif
 #endif
 		    TAINT_PROPER("require");
 		    tryname = SvPVX_const(namesv);
-		    tryrsfp = doopen_pm(tryname, PERL_SCRIPT_MODE);
+		    tryrsfp = doopen_pm(tryname, SvCUR(namesv));
 		    if (tryrsfp) {
 			if (tryname[0] == '.' && tryname[1] == '/')
 			    tryname += 2;
@@ -3376,22 +3549,26 @@ PP(pp_require)
     /* name is never assigned to again, so len is still strlen(name)  */
     /* Check whether a hook in @INC has already filled %INC */
     if (!hook_sv) {
-	(void)hv_store(GvHVn(PL_incgv), name, len, newSVpv(CopFILE(&PL_compiling),0),0);
+	(void)hv_store(GvHVn(PL_incgv),
+		       unixname, unixlen, newSVpv(CopFILE(&PL_compiling),0),0);
     } else {
-	SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+	SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
 	if (!svp)
-	    (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc_simple(hook_sv), 0 );
+	    (void)hv_store(GvHVn(PL_incgv),
+			   unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 );
     }
 
     ENTER;
     SAVETMPS;
-    lex_start(NULL);
-    SAVEGENERICSV(PL_rsfp_filters);
-    PL_rsfp_filters = NULL;
+    lex_start(NULL, tryrsfp, TRUE);
 
-    PL_rsfp = tryrsfp;
     SAVEHINTS();
     PL_hints = 0;
+    if (PL_compiling.cop_hints_hash) {
+	Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
+	PL_compiling.cop_hints_hash = NULL;
+    }
+
     SAVECOMPILEWARNINGS();
     if (PL_dowarn & G_WARN_ALL_ON)
         PL_compiling.cop_warnings = pWARN_ALL ;
@@ -3410,7 +3587,7 @@ PP(pp_require)
 
     /* switch to eval mode */
     PUSHBLOCK(cx, CXt_EVAL, SP);
-    PUSHEVAL(cx, name, NULL);
+    PUSHEVAL(cx, name);
     cx->blk_eval.retop = PL_op->op_next;
 
     SAVECOPLINE(&PL_compiling);
@@ -3422,7 +3599,10 @@ PP(pp_require)
     encoding = PL_encoding;
     PL_encoding = NULL;
 
-    op = DOCATCH(doeval(gimme, NULL, NULL, PL_curcop->cop_seq));
+    if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq))
+	op = DOCATCH(PL_eval_start);
+    else
+	op = PL_op->op_next;
 
     /* Restore encoding. */
     PL_encoding = encoding;
@@ -3441,7 +3621,7 @@ PP(pp_entereval)
     char *tmpbuf = tbuf;
     char *safestr;
     STRLEN len;
-    OP *ret;
+    bool ok;
     CV* runcv;
     U32 seq;
     HV *saved_hh = NULL;
@@ -3457,7 +3637,7 @@ PP(pp_entereval)
     TAINT_PROPER("eval");
 
     ENTER;
-    lex_start(sv);
+    lex_start(sv, NULL, FALSE);
     SAVETMPS;
 
     /* switch to eval mode */
@@ -3506,21 +3686,21 @@ PP(pp_entereval)
     runcv = find_runcv(&seq);
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
-    PUSHEVAL(cx, 0, NULL);
+    PUSHEVAL(cx, 0);
     cx->blk_eval.retop = PL_op->op_next;
 
     /* prepare to compile string */
 
     if (PERLDB_LINE && PL_curstash != PL_debstash)
-	save_lines(CopFILEAV(&PL_compiling), PL_linestr);
+	save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
-    ret = doeval(gimme, NULL, runcv, seq);
+    ok = doeval(gimme, NULL, runcv, seq);
     if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
-	&& ret != PL_op->op_next) {	/* Successive compilation. */
+	&& ok) {
 	/* Copy in anything fake and short. */
 	my_strlcpy(safestr, fakestr, fakelen);
     }
-    return DOCATCH(ret);
+    return ok ? DOCATCH(PL_eval_start) : PL_op->op_next;
 }
 
 PP(pp_leaveeval)
@@ -3623,7 +3803,7 @@ Perl_create_eval_scope(pTHX_ U32 flags)
     SAVETMPS;
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
-    PUSHEVAL(cx, 0, 0);
+    PUSHEVAL(cx, 0);
 
     PL_in_eval = EVAL_INEVAL;
     if (flags & G_KEEPERR)
@@ -3738,26 +3918,29 @@ PP(pp_leavegiven)
 }
 
 /* Helper routines used by pp_smartmatch */
-STATIC
-PMOP *
-S_make_matcher(pTHX_ regexp *re)
+STATIC PMOP *
+S_make_matcher(pTHX_ REGEXP *re)
 {
     dVAR;
     PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
+
+    PERL_ARGS_ASSERT_MAKE_MATCHER;
+
     PM_SETRE(matcher, ReREFCNT_inc(re));
-    
+
     SAVEFREEOP((OP *) matcher);
     ENTER; SAVETMPS;
     SAVEOP();
     return matcher;
 }
 
-STATIC
-bool
+STATIC bool
 S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
 {
     dVAR;
     dSP;
+
+    PERL_ARGS_ASSERT_MATCHER_MATCHES_SV;
     
     PL_op = (OP *) matcher;
     XPUSHs(sv);
@@ -3767,12 +3950,14 @@ S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
     return (SvTRUEx(POPs));
 }
 
-STATIC
-void
+STATIC void
 S_destroy_matcher(pTHX_ PMOP *matcher)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_DESTROY_MATCHER;
     PERL_UNUSED_ARG(matcher);
+
     FREETMPS;
     LEAVE;
 }
@@ -3786,8 +3971,7 @@ PP(pp_smartmatch)
 /* This version of do_smartmatch() implements the
  * table of smart matches that is found in perlsyn.
  */
-STATIC
-OP *
+STATIC OP *
 S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 {
     dVAR;
@@ -3796,8 +3980,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     SV *e = TOPs;	/* e is for 'expression' */
     SV *d = TOPm1s;	/* d is for 'default', as in PL_defgv */
     SV *This, *Other;	/* 'This' (and Other to match) to play with C++ */
-    MAGIC *mg;
-    regexp *this_regex, *other_regex;
+    REGEXP *this_regex, *other_regex;
 
 #   define NOT_EMPTY_PROTO(cv) (!SvPOK(cv) || SvCUR(cv) == 0)
 
@@ -3812,24 +3995,22 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	    && NOT_EMPTY_PROTO(This) && (Other = d)))
 
 #   define SM_REGEX ( \
-	   (SvROK(d) && SvMAGICAL(This = SvRV(d))			\
-	&& (mg = mg_find(This, PERL_MAGIC_qr))				\
-	&& (this_regex = (regexp *)mg->mg_obj)				\
+	   (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP)		\
+	&& (this_regex = (REGEXP*) This)				\
 	&& (Other = e))							\
     ||									\
-	   (SvROK(e) && SvMAGICAL(This = SvRV(e))			\
-	&& (mg = mg_find(This, PERL_MAGIC_qr))				\
-	&& (this_regex = (regexp *)mg->mg_obj)				\
+	   (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_REGEXP)		\
+	&& (this_regex = (REGEXP*) This)				\
 	&& (Other = d))	)
 	
 
 #   define SM_OTHER_REF(type) \
 	(SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
 
-#   define SM_OTHER_REGEX (SvROK(Other) && SvMAGICAL(SvRV(Other))	\
-	&& (mg = mg_find(SvRV(Other), PERL_MAGIC_qr))			\
-	&& (other_regex = (regexp *)mg->mg_obj))
-	
+#   define SM_OTHER_REGEX (SvROK(Other)					\
+	&& (SvTYPE(SvRV(Other)) == SVt_REGEXP)				\
+	&& (other_regex = (REGEXP*) SvRV(Other)))
+
 
 #   define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
 	sv_2mortal(newSViv(PTR2IV(sv))), 0)
@@ -3938,23 +4119,19 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 	    AV * const other_av = (AV *) SvRV(Other);
 	    const I32 other_len = av_len(other_av) + 1;
 	    I32 i;
-	    
-	    if (HvUSEDKEYS((HV *) This) != other_len)
-		RETPUSHNO;
-	    
-	    for(i = 0; i < other_len; ++i) {
+
+	    for (i = 0; i < other_len; ++i) {
 		SV ** const svp = av_fetch(other_av, i, FALSE);
 		char *key;
 		STRLEN key_len;
 
-		if (!svp)	/* ??? When can this happen? */
-		    RETPUSHNO;
-
-		key = SvPV(*svp, key_len);
-	    	if(!hv_exists((HV *) This, key, key_len))
-		    RETPUSHNO;
+		if (svp) {	/* ??? When can this not happen? */
+		    key = SvPV(*svp, key_len);
+		    if (hv_exists((HV *) This, key, key_len))
+		        RETPUSHYES;
+		}
 	    }
-	    RETPUSHYES;
+	    RETPUSHNO;
 	}
 	else if (SM_OTHER_REGEX) {
 	    PMOP * const matcher = make_matcher(other_regex);
@@ -4010,12 +4187,12 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 			    RETPUSHNO;
 		    }
 		    else {
-			hv_store_ent(seen_this,
-			    sv_2mortal(newSViv(PTR2IV(*this_elem))),
-			    &PL_sv_undef, 0);
-			hv_store_ent(seen_other,
-			    sv_2mortal(newSViv(PTR2IV(*other_elem))),
-			    &PL_sv_undef, 0);
+			(void)hv_store_ent(seen_this,
+				sv_2mortal(newSViv(PTR2IV(*this_elem))),
+				&PL_sv_undef, 0);
+			(void)hv_store_ent(seen_other,
+				sv_2mortal(newSViv(PTR2IV(*other_elem))),
+				&PL_sv_undef, 0);
 			PUSHs(*this_elem);
 			PUSHs(*other_elem);
 			
@@ -4284,6 +4461,8 @@ S_doparseform(pTHX_ SV *sv)
     bool unchopnum = FALSE;
     int maxops = 12; /* FF_LINEMARK + FF_END + 10 (\0 without preceding \n) */
 
+    PERL_ARGS_ASSERT_DOPARSEFORM;
+
     if (len == 0)
 	Perl_croak(aTHX_ "Null picture in formline");
 
@@ -4526,12 +4705,14 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     bool read_from_cache = FALSE;
     STRLEN umaxlen;
 
+    PERL_ARGS_ASSERT_RUN_USER_FILTER;
+
     assert(maxlen >= 0);
     umaxlen = maxlen;
 
     /* I was having segfault trouble under Linux 2.2.5 after a
        parse error occured.  (Had to hack around it with a test
-       for PL_error_count == 0.)  Solaris doesn't segfault --
+       for PL_parser->error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
     if (IoFMT_GV(datasv)) {
@@ -4596,7 +4777,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
 	DEFSV = upstream;
 	PUSHMARK(SP);
-	PUSHs(sv_2mortal(newSViv(0)));
+	mPUSHi(0);
 	if (filter_state) {
 	    PUSHs(filter_state);
 	}
@@ -4692,6 +4873,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 static bool
 S_path_is_absolute(const char *name)
 {
+    PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE;
+
     if (PERL_FILE_IS_ABSOLUTE(name)
 #ifdef MACOS_TRADITIONAL
 	|| (*name == ':')