X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=67a2d1167d42d365beb598d10603b8aa4b734d3e;hb=484c818fbcf400d897228be2cf2b34b67be8a340;hp=38ba12e0de50ffcfb220101c54c2c54d9ce4c959;hpb=ea726b52599b52cf534201a46ec3455418c9eb8e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 38ba12e..67a2d11 100644
--- a/pp.c
+++ b/pp.c
@@ -9,8 +9,11 @@
  */
 
 /*
- * "It's a big house this, and very peculiar.  Always a bit more to discover,
- * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
+ * 'It's a big house this, and very peculiar.  Always a bit more
+ *  to discover, and no knowing what you'll find round a corner.
+ *  And Elves, sir!'                            --Samwise Gamgee
+ *
+ *     [p.225 of _The Lord of the Rings_, II/i: "Many Meetings"]
  */
 
 /* This file contains general pp ("push/pop") functions that execute the
@@ -75,23 +78,23 @@ PP(pp_padav)
     }
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
-	const I32 maxarg = AvFILL((AV*)TARG) + 1;
+	const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
 	EXTEND(SP, maxarg);
 	if (SvMAGICAL(TARG)) {
 	    U32 i;
 	    for (i=0; i < (U32)maxarg; i++) {
-		SV * const * const svp = av_fetch((AV*)TARG, i, FALSE);
+		SV * const * const svp = av_fetch(MUTABLE_AV(TARG), i, FALSE);
 		SP[i+1] = (svp) ? *svp : &PL_sv_undef;
 	    }
 	}
 	else {
-	    Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+	    Copy(AvARRAY((const AV *)TARG), SP+1, maxarg, SV*);
 	}
 	SP += maxarg;
     }
     else if (gimme == G_SCALAR) {
 	SV* const sv = sv_newmortal();
-	const I32 maxarg = AvFILL((AV*)TARG) + 1;
+	const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
 	sv_setiv(sv, maxarg);
 	PUSHs(sv);
     }
@@ -137,11 +140,11 @@ PP(pp_rv2gv)
 
 	sv = SvRV(sv);
 	if (SvTYPE(sv) == SVt_PVIO) {
-	    GV * const gv = (GV*) sv_newmortal();
+	    GV * const gv = MUTABLE_GV(sv_newmortal());
 	    gv_init(gv, 0, "", 0, 0);
-	    GvIOp(gv) = (IO *)sv;
+	    GvIOp(gv) = MUTABLE_IO(sv);
 	    SvREFCNT_inc_void_NN(sv);
-	    sv = (SV*) gv;
+	    sv = MUTABLE_SV(gv);
 	}
 	else if (!isGV_with_GP(sv))
 	    DIE(aTHX_ "Not a GLOB reference");
@@ -158,14 +161,14 @@ PP(pp_rv2gv)
 		 * NI-S 1999/05/07
 		 */
 		if (SvREADONLY(sv))
-		    Perl_croak(aTHX_ PL_no_modify);
+		    Perl_croak(aTHX_ "%s", PL_no_modify);
 		if (PL_op->op_private & OPpDEREF) {
 		    GV *gv;
 		    if (cUNOP->op_targ) {
 			STRLEN len;
 			SV * const namesv = PAD_SV(cUNOP->op_targ);
 			const char * const name = SvPV(namesv, len);
-			gv = (GV*)newSV(0);
+			gv = MUTABLE_GV(newSV(0));
 			gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
 		    }
 		    else {
@@ -173,7 +176,7 @@ PP(pp_rv2gv)
 			gv = newGVgen(name);
 		    }
 		    prepare_SV_for_RV(sv);
-		    SvRV_set(sv, (SV*)gv);
+		    SvRV_set(sv, MUTABLE_SV(gv));
 		    SvROK_on(sv);
 		    SvSETMAGIC(sv);
 		    goto wasref;
@@ -188,17 +191,18 @@ PP(pp_rv2gv)
 	    if ((PL_op->op_flags & OPf_SPECIAL) &&
 		!(PL_op->op_flags & OPf_MOD))
 	    {
-		SV * const temp = (SV*)gv_fetchsv(sv, 0, SVt_PVGV);
+		SV * const temp = MUTABLE_SV(gv_fetchsv(sv, 0, SVt_PVGV));
 		if (!temp
 		    && (!is_gv_magical_sv(sv,0)
-			|| !(sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV)))) {
+			|| !(sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD,
+							SVt_PVGV))))) {
 		    RETSETUNDEF;
 		}
 		sv = temp;
 	    }
 	    else {
 		if (PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(aTHX_ PL_no_symref_sv, sv, "a symbol");
+		    DIE(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), "a symbol");
 		if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
 		    == OPpDONT_INIT_GV) {
 		    /* We are the target of a coderef assignment.  Return
@@ -206,12 +210,12 @@ PP(pp_rv2gv)
 		       things.  */
 		    RETURN;
 		}
-		sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV);
+		sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV));
 	    }
 	}
     }
     if (PL_op->op_private & OPpLVAL_INTRO)
-	save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
+	save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
     SETs(sv);
     RETURN;
 }
@@ -228,7 +232,7 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
 
     if (PL_op->op_private & HINT_STRICT_REFS) {
 	if (SvOK(sv))
-	    Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+	    Perl_die(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), what);
 	else
 	    Perl_die(aTHX_ PL_no_usym, what);
     }
@@ -283,7 +287,7 @@ PP(pp_rv2sv)
 	}
     }
     else {
-	gv = (GV*)sv;
+	gv = MUTABLE_GV(sv);
 
 	if (!isGV_with_GP(gv)) {
 	    if (SvGMAGICAL(sv)) {
@@ -300,11 +304,11 @@ PP(pp_rv2sv)
     if (PL_op->op_flags & OPf_MOD) {
 	if (PL_op->op_private & OPpLVAL_INTRO) {
 	    if (cUNOP->op_first->op_type == OP_NULL)
-		sv = save_scalar((GV*)TOPs);
+		sv = save_scalar(MUTABLE_GV(TOPs));
 	    else if (gv)
 		sv = save_scalar(gv);
 	    else
-		Perl_croak(aTHX_ PL_no_localize_ref);
+		Perl_croak(aTHX_ "%s", PL_no_localize_ref);
 	}
 	else if (PL_op->op_private & OPpDEREF)
 	    vivify_ref(sv, PL_op->op_private & OPpDEREF);
@@ -316,13 +320,20 @@ PP(pp_rv2sv)
 PP(pp_av2arylen)
 {
     dVAR; dSP;
-    AV * const av = (AV*)TOPs;
-    SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av);
-    if (!*sv) {
-	*sv = newSV_type(SVt_PVMG);
-	sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, NULL, 0);
+    AV * const av = MUTABLE_AV(TOPs);
+    const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+    if (lvalue) {
+	SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
+	if (!*sv) {
+	    *sv = newSV_type(SVt_PVMG);
+	    sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+	}
+	SETs(*sv);
+    } else {
+	SETs(sv_2mortal(newSViv(
+	    AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop)
+	)));
     }
-    SETs(*sv);
     RETURN;
 }
 
@@ -338,8 +349,7 @@ PP(pp_pos)
 
 	LvTYPE(TARG) = '.';
 	if (LvTARG(TARG) != sv) {
-	    if (LvTARG(TARG))
-		SvREFCNT_dec(LvTARG(TARG));
+	    SvREFCNT_dec(LvTARG(TARG));
 	    LvTARG(TARG) = SvREFCNT_inc_simple(sv);
 	}
 	PUSHs(TARG);	/* no SvSETMAGIC */
@@ -376,7 +386,7 @@ PP(pp_rv2cv)
     CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags);
     if (cv) {
 	if (CvCLONE(cv))
-	    cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv)));
+	    cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
 	if ((PL_op->op_private & OPpLVAL_INTRO)) {
 	    if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
 		cv = GvCV(gv);
@@ -389,7 +399,7 @@ PP(pp_rv2cv)
     }    
     else
 	cv = MUTABLE_CV(&PL_sv_undef);
-    SETs((SV*)cv);
+    SETs(MUTABLE_SV(cv));
     RETURN;
 }
 
@@ -418,6 +428,10 @@ PP(pp_prototype)
 		    ret = newSVpvs_flags("_;$", SVs_TEMP);
 		    goto set;
 		}
+		if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
+		    ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+		    goto set;
+		}
 		if (code == -KEY_readpipe) {
 		    s = "CORE::backtick";
 		}
@@ -474,9 +488,9 @@ PP(pp_anoncode)
     dVAR; dSP;
     CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ));
     if (CvCLONE(cv))
-	cv = MUTABLE_CV(sv_2mortal((SV*)cv_clone(cv)));
+	cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
     EXTEND(SP,1);
-    PUSHs((SV*)cv);
+    PUSHs(MUTABLE_SV(cv));
     RETURN;
 }
 
@@ -522,8 +536,8 @@ S_refto(pTHX_ SV *sv)
 	    SvREFCNT_inc_void_NN(sv);
     }
     else if (SvTYPE(sv) == SVt_PVAV) {
-	if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
-	    av_reify((AV*)sv);
+	if (!AvREAL((const AV *)sv) && AvREIFY((const AV *)sv))
+	    av_reify(MUTABLE_AV(sv));
 	SvTEMP_off(sv);
 	SvREFCNT_inc_void_NN(sv);
     }
@@ -572,9 +586,9 @@ PP(pp_bless)
 	if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
 	    Perl_croak(aTHX_ "Attempt to bless into a reference");
 	ptr = SvPV_const(ssv,len);
-	if (len == 0 && ckWARN(WARN_MISC))
-	    Perl_warner(aTHX_ packWARN(WARN_MISC),
-		   "Explicit blessing to '' (assuming package main)");
+	if (len == 0)
+	    Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
+			   "Explicit blessing to '' (assuming package main)");
 	stash = gv_stashpvn(ptr, len, GV_ADD);
     }
 
@@ -588,7 +602,7 @@ PP(pp_gelem)
 
     SV *sv = POPs;
     const char * const elem = SvPV_nolen_const(sv);
-    GV * const gv = (GV*)POPs;
+    GV * const gv = MUTABLE_GV(POPs);
     SV * tmpRef = NULL;
 
     sv = NULL;
@@ -598,33 +612,33 @@ PP(pp_gelem)
 	switch (*elem) {
 	case 'A':
 	    if (strEQ(second_letter, "RRAY"))
-		tmpRef = (SV*)GvAV(gv);
+		tmpRef = MUTABLE_SV(GvAV(gv));
 	    break;
 	case 'C':
 	    if (strEQ(second_letter, "ODE"))
-		tmpRef = (SV*)GvCVu(gv);
+		tmpRef = MUTABLE_SV(GvCVu(gv));
 	    break;
 	case 'F':
 	    if (strEQ(second_letter, "ILEHANDLE")) {
 		/* finally deprecated in 5.8.0 */
 		deprecate("*glob{FILEHANDLE}");
-		tmpRef = (SV*)GvIOp(gv);
+		tmpRef = MUTABLE_SV(GvIOp(gv));
 	    }
 	    else
 		if (strEQ(second_letter, "ORMAT"))
-		    tmpRef = (SV*)GvFORM(gv);
+		    tmpRef = MUTABLE_SV(GvFORM(gv));
 	    break;
 	case 'G':
 	    if (strEQ(second_letter, "LOB"))
-		tmpRef = (SV*)gv;
+		tmpRef = MUTABLE_SV(gv);
 	    break;
 	case 'H':
 	    if (strEQ(second_letter, "ASH"))
-		tmpRef = (SV*)GvHV(gv);
+		tmpRef = MUTABLE_SV(GvHV(gv));
 	    break;
 	case 'I':
 	    if (*second_letter == 'O' && !elem[2])
-		tmpRef = (SV*)GvIOp(gv);
+		tmpRef = MUTABLE_SV(GvIOp(gv));
 	    break;
 	case 'N':
 	    if (strEQ(second_letter, "AME"))
@@ -803,16 +817,16 @@ PP(pp_undef)
     case SVt_NULL:
 	break;
     case SVt_PVAV:
-	av_undef((AV*)sv);
+	av_undef(MUTABLE_AV(sv));
 	break;
     case SVt_PVHV:
 	hv_undef(MUTABLE_HV(sv));
 	break;
     case SVt_PVCV:
-	if (cv_const_sv((const CV *)sv) && ckWARN(WARN_MISC))
-	    Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
-		 CvANON((const CV *)sv) ? "(anonymous)"
-			: GvENAME(CvGV((const CV *)sv)));
+	if (cv_const_sv((const CV *)sv))
+	    Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
+			   CvANON((const CV *)sv) ? "(anonymous)"
+			   : GvENAME(CvGV((const CV *)sv)));
 	/* FALLTHROUGH */
     case SVt_PVFM:
 	{
@@ -832,18 +846,19 @@ PP(pp_undef)
             HV *stash;
 
             /* undef *Foo:: */
-            if((stash = GvHV((GV*)sv)) && HvNAME_get(stash))
+            if((stash = GvHV((const GV *)sv)) && HvNAME_get(stash))
                 mro_isa_changed_in(stash);
             /* undef *Pkg::meth_name ... */
-            else if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash))
+            else if(GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
+		    && HvNAME_get(stash))
                 mro_method_changed_in(stash);
 
-	    gp_free((GV*)sv);
+	    gp_free(MUTABLE_GV(sv));
 	    Newxz(gp, 1, GP);
 	    GvGP(sv) = gp_ref(gp);
 	    GvSV(sv) = newSV(0);
 	    GvLINE(sv) = CopLINE(PL_curcop);
-	    GvEGV(sv) = (GV*)sv;
+	    GvEGV(sv) = MUTABLE_GV(sv);
 	    GvMULTI_on(sv);
 	    break;
 	}
@@ -865,7 +880,7 @@ PP(pp_predec)
 {
     dVAR; dSP;
     if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
-	DIE(aTHX_ PL_no_modify);
+	DIE(aTHX_ "%s", PL_no_modify);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MIN)
     {
@@ -882,7 +897,7 @@ PP(pp_postinc)
 {
     dVAR; dSP; dTARGET;
     if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
-	DIE(aTHX_ PL_no_modify);
+	DIE(aTHX_ "%s", PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MAX)
@@ -904,7 +919,7 @@ PP(pp_postdec)
 {
     dVAR; dSP; dTARGET;
     if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
-	DIE(aTHX_ PL_no_modify);
+	DIE(aTHX_ "%s", PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MIN)
@@ -1549,7 +1564,7 @@ PP(pp_repeat)
 	    }
 	    MARK++;
 	    repeatcpy((char*)(MARK + items), (char*)MARK,
-		items * sizeof(SV*), count - 1);
+		items * sizeof(const SV *), count - 1);
 	    SP += max;
 	}
 	else if (count <= 0)
@@ -2431,7 +2446,7 @@ PP(pp_negate)
 	    STRLEN len;
 	    const char * const s = SvPV_const(sv, len);
 	    if (isIDFIRST(*s)) {
-		sv_setpvn(TARG, "-", 1);
+		sv_setpvs(TARG, "-");
 		sv_catsv(TARG, sv);
 	    }
 	    else if (*s == '+' || *s == '-') {
@@ -2445,7 +2460,7 @@ PP(pp_negate)
 		if (SvNOK(sv))
 		    sv_setnv(TARG, -SvNV(sv));
 		else {
-		    sv_setpvn(TARG, "-", 1);
+		    sv_setpvs(TARG, "-");
 		    sv_catsv(TARG, sv);
 		}
 	    }
@@ -2548,7 +2563,7 @@ PP(pp_complement)
 	      sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
 	      SvUTF8_off(TARG);
 	  }
-	  SETs(TARG);
+	  SETTARG;
 	  RETURN;
 	}
 #ifdef LIBERAL
@@ -2564,8 +2579,7 @@ PP(pp_complement)
 #endif
 	for ( ; anum > 0; anum--, tmps++)
 	    *tmps = ~*tmps;
-
-	SETs(TARG);
+	SETTARG;
       }
       RETURN;
     }
@@ -3144,8 +3158,7 @@ PP(pp_substr)
     if (fail < 0) {
 	if (lvalue || repl)
 	    Perl_croak(aTHX_ "substr outside of string");
-	if (ckWARN(WARN_SUBSTR))
-	    Perl_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
+	Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
 	RETPUSHUNDEF;
     }
     else {
@@ -3187,16 +3200,14 @@ PP(pp_substr)
 	    sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
 	    if (repl_is_utf8)
 		SvUTF8_on(sv);
-	    if (repl_sv_copy)
-		SvREFCNT_dec(repl_sv_copy);
+	    SvREFCNT_dec(repl_sv_copy);
 	}
 	else if (lvalue) {		/* it's an lvalue! */
 	    if (!SvGMAGICAL(sv)) {
 		if (SvROK(sv)) {
 		    SvPV_force_nolen(sv);
-		    if (ckWARN(WARN_SUBSTR))
-			Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
-				"Attempt to use reference as lvalue in substr");
+		    Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+				   "Attempt to use reference as lvalue in substr");
 		}
 		if (isGV_with_GP(sv))
 		    SvPV_force_nolen(sv);
@@ -3213,8 +3224,7 @@ PP(pp_substr)
 
 	    LvTYPE(TARG) = 'x';
 	    if (LvTARG(TARG) != sv) {
-		if (LvTARG(TARG))
-		    SvREFCNT_dec(LvTARG(TARG));
+		SvREFCNT_dec(LvTARG(TARG));
 		LvTARG(TARG) = SvREFCNT_inc_simple(sv);
 	    }
 	    LvTARGOFF(TARG) = upos;
@@ -3244,8 +3254,7 @@ PP(pp_vec)
 	}
 	LvTYPE(TARG) = 'v';
 	if (LvTARG(TARG) != src) {
-	    if (LvTARG(TARG))
-		SvREFCNT_dec(LvTARG(TARG));
+	    SvREFCNT_dec(LvTARG(TARG));
 	    LvTARG(TARG) = SvREFCNT_inc_simple(src);
 	}
 	LvTARGOFF(TARG) = offset;
@@ -3371,8 +3380,7 @@ PP(pp_index)
 	if (retval > 0 && big_utf8)
 	    sv_pos_b2u(big, &retval);
     }
-    if (temp)
-	SvREFCNT_dec(temp);
+    SvREFCNT_dec(temp);
  fail:
     PUSHi(retval + arybase);
     RETURN;
@@ -3509,7 +3517,7 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
 #   endif
-    SETs(TARG);
+    SETTARG;
     RETURN;
 #else
     DIE(aTHX_
@@ -3894,9 +3902,7 @@ PP(pp_quotemeta)
     }
     else
 	sv_setpvn(TARG, s, len);
-    SETs(TARG);
-    if (SvSMAGICAL(TARG))
-	mg_set(TARG);
+    SETTARG;
     RETURN;
 }
 
@@ -3905,12 +3911,22 @@ PP(pp_quotemeta)
 PP(pp_aslice)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    register AV* const av = (AV*)POPs;
+    register AV *const av = MUTABLE_AV(POPs);
     register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
 
     if (SvTYPE(av) == SVt_PVAV) {
 	const I32 arybase = CopARYBASE_get(PL_curcop);
-	if (lval && PL_op->op_private & OPpLVAL_INTRO) {
+	const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+	bool can_preserve = FALSE;
+
+	if (localizing) {
+	    MAGIC *mg;
+	    HV *stash;
+
+	    can_preserve = SvCANEXISTDELETE(av);
+	}
+
+	if (lval && localizing) {
 	    register SV **svp;
 	    I32 max = -1;
 	    for (svp = MARK + 1; svp <= SP; svp++) {
@@ -3921,18 +3937,32 @@ PP(pp_aslice)
 	    if (max > AvMAX(av))
 		av_extend(av, max);
 	}
+
 	while (++MARK <= SP) {
 	    register SV **svp;
 	    I32 elem = SvIV(*MARK);
+	    bool preeminent = TRUE;
 
 	    if (elem > 0)
 		elem -= arybase;
+	    if (localizing && can_preserve) {
+		/* If we can determine whether the element exist,
+		 * Try to preserve the existenceness of a tied array
+		 * element by using EXISTS and DELETE if possible.
+		 * Fallback to FETCH and STORE otherwise. */
+		preeminent = av_exists(av, elem);
+	    }
+
 	    svp = av_fetch(av, elem, lval);
 	    if (lval) {
 		if (!svp || *svp == &PL_sv_undef)
 		    DIE(aTHX_ PL_no_aelem, elem);
-		if (PL_op->op_private & OPpLVAL_INTRO)
-		    save_aelem(av, elem, svp);
+		if (localizing) {
+		    if (preeminent)
+			save_aelem(av, elem, svp);
+		    else
+			SAVEADELETE(av, elem);
+		}
 	    }
 	    *MARK = svp ? *svp : &PL_sv_undef;
 	}
@@ -3949,7 +3979,7 @@ PP(pp_aeach)
 {
     dVAR;
     dSP;
-    AV *array = (AV*)POPs;
+    AV *array = MUTABLE_AV(POPs);
     const I32 gimme = GIMME_V;
     IV *iterp = Perl_av_iter_p(aTHX_ array);
     const IV current = (*iterp)++;
@@ -3975,7 +4005,7 @@ PP(pp_akeys)
 {
     dVAR;
     dSP;
-    AV *array = (AV*)POPs;
+    AV *array = MUTABLE_AV(POPs);
     const I32 gimme = GIMME_V;
 
     *Perl_av_iter_p(aTHX_ array) = 0;
@@ -4040,12 +4070,195 @@ PP(pp_each)
     RETURN;
 }
 
-PP(pp_delete)
+STATIC OP *
+S_do_delete_local(pTHX)
 {
     dVAR;
     dSP;
     const I32 gimme = GIMME_V;
-    const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
+    const MAGIC *mg;
+    HV *stash;
+
+    if (PL_op->op_private & OPpSLICE) {
+	dMARK; dORIGMARK;
+	SV * const osv = POPs;
+	const bool tied = SvRMAGICAL(osv)
+			    && mg_find((const SV *)osv, PERL_MAGIC_tied);
+	const bool can_preserve = SvCANEXISTDELETE(osv)
+				    || mg_find((const SV *)osv, PERL_MAGIC_env);
+	const U32 type = SvTYPE(osv);
+	if (type == SVt_PVHV) {			/* hash element */
+	    HV * const hv = MUTABLE_HV(osv);
+	    while (++MARK <= SP) {
+		SV * const keysv = *MARK;
+		SV *sv = NULL;
+		bool preeminent = TRUE;
+		if (can_preserve)
+		    preeminent = hv_exists_ent(hv, keysv, 0);
+		if (tied) {
+		    HE *he = hv_fetch_ent(hv, keysv, 1, 0);
+		    if (he)
+			sv = HeVAL(he);
+		    else
+			preeminent = FALSE;
+		}
+		else {
+		    sv = hv_delete_ent(hv, keysv, 0, 0);
+		    SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+		}
+		if (preeminent) {
+		    save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
+		    if (tied) {
+			*MARK = sv_mortalcopy(sv);
+			mg_clear(sv);
+		    } else
+			*MARK = sv;
+		}
+		else {
+		    SAVEHDELETE(hv, keysv);
+		    *MARK = &PL_sv_undef;
+		}
+	    }
+	}
+	else if (type == SVt_PVAV) {                  /* array element */
+	    if (PL_op->op_flags & OPf_SPECIAL) {
+		AV * const av = MUTABLE_AV(osv);
+		while (++MARK <= SP) {
+		    I32 idx = SvIV(*MARK);
+		    SV *sv = NULL;
+		    bool preeminent = TRUE;
+		    if (can_preserve)
+			preeminent = av_exists(av, idx);
+		    if (tied) {
+			SV **svp = av_fetch(av, idx, 1);
+			if (svp)
+			    sv = *svp;
+			else
+			    preeminent = FALSE;
+		    }
+		    else {
+			sv = av_delete(av, idx, 0);
+		        SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+		    }
+		    if (preeminent) {
+		        save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM);
+			if (tied) {
+			    *MARK = sv_mortalcopy(sv);
+			    mg_clear(sv);
+			} else
+			    *MARK = sv;
+		    }
+		    else {
+		        SAVEADELETE(av, idx);
+		        *MARK = &PL_sv_undef;
+		    }
+		}
+	    }
+	}
+	else
+	    DIE(aTHX_ "Not a HASH reference");
+	if (gimme == G_VOID)
+	    SP = ORIGMARK;
+	else if (gimme == G_SCALAR) {
+	    MARK = ORIGMARK;
+	    if (SP > MARK)
+		*++MARK = *SP;
+	    else
+		*++MARK = &PL_sv_undef;
+	    SP = MARK;
+	}
+    }
+    else {
+	SV * const keysv = POPs;
+	SV * const osv   = POPs;
+	const bool tied = SvRMAGICAL(osv)
+			    && mg_find((const SV *)osv, PERL_MAGIC_tied);
+	const bool can_preserve = SvCANEXISTDELETE(osv)
+				    || mg_find((const SV *)osv, PERL_MAGIC_env);
+	const U32 type = SvTYPE(osv);
+	SV *sv = NULL;
+	if (type == SVt_PVHV) {
+	    HV * const hv = MUTABLE_HV(osv);
+	    bool preeminent = TRUE;
+	    if (can_preserve)
+		preeminent = hv_exists_ent(hv, keysv, 0);
+	    if (tied) {
+		HE *he = hv_fetch_ent(hv, keysv, 1, 0);
+		if (he)
+		    sv = HeVAL(he);
+		else
+		    preeminent = FALSE;
+	    }
+	    else {
+		sv = hv_delete_ent(hv, keysv, 0, 0);
+		SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+	    }
+	    if (preeminent) {
+		save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
+		if (tied) {
+		    SV *nsv = sv_mortalcopy(sv);
+		    mg_clear(sv);
+		    sv = nsv;
+		}
+	    }
+	    else
+		SAVEHDELETE(hv, keysv);
+	}
+	else if (type == SVt_PVAV) {
+	    if (PL_op->op_flags & OPf_SPECIAL) {
+		AV * const av = MUTABLE_AV(osv);
+		I32 idx = SvIV(keysv);
+		bool preeminent = TRUE;
+		if (can_preserve)
+		    preeminent = av_exists(av, idx);
+		if (tied) {
+		    SV **svp = av_fetch(av, idx, 1);
+		    if (svp)
+			sv = *svp;
+		    else
+			preeminent = FALSE;
+		}
+		else {
+		    sv = av_delete(av, idx, 0);
+		    SvREFCNT_inc_simple_void(sv); /* De-mortalize */
+		}
+		if (preeminent) {
+		    save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM);
+		    if (tied) {
+			SV *nsv = sv_mortalcopy(sv);
+			mg_clear(sv);
+			sv = nsv;
+		    }
+		}
+		else
+		    SAVEADELETE(av, idx);
+	    }
+	    else
+		DIE(aTHX_ "panic: avhv_delete no longer supported");
+	}
+	else
+	    DIE(aTHX_ "Not a HASH reference");
+	if (!sv)
+	    sv = &PL_sv_undef;
+	if (gimme != G_VOID)
+	    PUSHs(sv);
+    }
+
+    RETURN;
+}
+
+PP(pp_delete)
+{
+    dVAR;
+    dSP;
+    I32 gimme;
+    I32 discard;
+
+    if (PL_op->op_private & OPpLVAL_INTRO)
+	return do_delete_local();
+
+    gimme = GIMME_V;
+    discard = (gimme == G_VOID) ? G_DISCARD : 0;
 
     if (PL_op->op_private & OPpSLICE) {
 	dMARK; dORIGMARK;
@@ -4060,7 +4273,7 @@ PP(pp_delete)
 	else if (hvtype == SVt_PVAV) {                  /* array element */
             if (PL_op->op_flags & OPf_SPECIAL) {
                 while (++MARK <= SP) {
-                    SV * const sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+                    SV * const sv = av_delete(MUTABLE_AV(hv), SvIV(*MARK), discard);
                     *MARK = sv ? sv : &PL_sv_undef;
                 }
             }
@@ -4086,7 +4299,7 @@ PP(pp_delete)
 	    sv = hv_delete_ent(hv, keysv, discard, 0);
 	else if (SvTYPE(hv) == SVt_PVAV) {
 	    if (PL_op->op_flags & OPf_SPECIAL)
-		sv = av_delete((AV*)hv, SvIV(keysv), discard);
+		sv = av_delete(MUTABLE_AV(hv), SvIV(keysv), discard);
 	    else
 		DIE(aTHX_ "panic: avhv_delete no longer supported");
 	}
@@ -4125,7 +4338,7 @@ PP(pp_exists)
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
 	if (PL_op->op_flags & OPf_SPECIAL) {		/* array element */
-	    if (av_exists((AV*)hv, SvIV(tmpsv)))
+	    if (av_exists(MUTABLE_AV(hv), SvIV(tmpsv)))
 		RETPUSHYES;
 	}
     }
@@ -4141,31 +4354,28 @@ PP(pp_hslice)
     register HV * const hv = MUTABLE_HV(POPs);
     register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
     const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
-    bool other_magic = FALSE;
+    bool can_preserve = FALSE;
 
     if (localizing) {
         MAGIC *mg;
         HV *stash;
 
-        other_magic = mg_find((SV*)hv, PERL_MAGIC_env) ||
-            ((mg = mg_find((SV*)hv, PERL_MAGIC_tied))
-             /* Try to preserve the existenceness of a tied hash
-              * element by using EXISTS and DELETE if possible.
-              * Fallback to FETCH and STORE otherwise */
-             && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
-             && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
-             && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+	if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+	    can_preserve = TRUE;
     }
 
     while (++MARK <= SP) {
         SV * const keysv = *MARK;
         SV **svp;
         HE *he;
-        bool preeminent = FALSE;
-
-        if (localizing) {
-            preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
-                hv_exists_ent(hv, keysv, 0);
+        bool preeminent = TRUE;
+
+        if (localizing && can_preserve) {
+	    /* If we can determine whether the element exist,
+             * try to preserve the existenceness of a tied hash
+             * element by using EXISTS and DELETE if possible.
+             * Fallback to FETCH and STORE otherwise. */
+            preeminent = hv_exists_ent(hv, keysv, 0);
         }
 
         he = hv_fetch_ent(hv, keysv, lval, 0);
@@ -4177,17 +4387,12 @@ PP(pp_hslice)
             }
             if (localizing) {
 		if (HvNAME_get(hv) && isGV(*svp))
-		    save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
-		else {
-		    if (preeminent)
-			save_helem(hv, keysv, svp);
-		    else {
-			STRLEN keylen;
-			const char * const key = SvPV_const(keysv, keylen);
-			SAVEDELETE(hv, savepvn(key,keylen),
-				   SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
-		    }
-		}
+		    save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
+		else if (preeminent)
+		    save_helem_flags(hv, keysv, svp,
+			 (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
+		else
+		    SAVEHDELETE(hv, keysv);
             }
         }
         *MARK = svp ? *svp : &PL_sv_undef;
@@ -4273,7 +4478,7 @@ PP(pp_anonlist)
 {
     dVAR; dSP; dMARK; dORIGMARK;
     const I32 items = SP - MARK;
-    SV * const av = (SV *) av_make(items, MARK+1);
+    SV * const av = MUTABLE_SV(av_make(items, MARK+1));
     SP = ORIGMARK;		/* av_make() might realloc stack_sp */
     mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
 	    ? newRV_noinc(av) : av);
@@ -4290,20 +4495,20 @@ PP(pp_anonhash)
 	SV * const val = newSV(0);
 	if (MARK < SP)
 	    sv_setsv(val, *++MARK);
-	else if (ckWARN(WARN_MISC))
-	    Perl_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
+	else
+	    Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Odd number of elements in anonymous hash");
 	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
     mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
-	    ? newRV_noinc((SV*) hv) : (SV*) hv);
+	    ? newRV_noinc(MUTABLE_SV(hv)) : MUTABLE_SV(hv));
     RETURN;
 }
 
 PP(pp_splice)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    register AV *ary = (AV*)*++MARK;
+    register AV *ary = MUTABLE_AV(*++MARK);
     register SV **src;
     register SV **dst;
     register I32 i;
@@ -4312,10 +4517,10 @@ PP(pp_splice)
     I32 newlen;
     I32 after;
     I32 diff;
-    const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
+    const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
 
     if (mg) {
-	*MARK-- = SvTIED_obj((SV*)ary, mg);
+	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
@@ -4351,8 +4556,7 @@ PP(pp_splice)
 	length = AvMAX(ary) + 1;
     }
     if (offset > AvFILLp(ary) + 1) {
-	if (ckWARN(WARN_MISC))
-	    Perl_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
+	Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "splice() offset past end of array" );
 	offset = AvFILLp(ary) + 1;
     }
     after = AvFILLp(ary) + 1 - (offset + length);
@@ -4508,19 +4712,17 @@ PP(pp_splice)
 PP(pp_push)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    register AV * const ary = (AV*)*++MARK;
-    const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
+    register AV * const ary = MUTABLE_AV(*++MARK);
+    const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
 
     if (mg) {
-	*MARK-- = SvTIED_obj((SV*)ary, mg);
+	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
 	call_method("PUSH",G_SCALAR|G_DISCARD);
 	LEAVE;
 	SPAGAIN;
-	SP = ORIGMARK;
-	PUSHi( AvFILL(ary) + 1 );
     }
     else {
 	PL_delaymagic = DM_DELAY;
@@ -4531,11 +4733,13 @@ PP(pp_push)
 	    av_store(ary, AvFILLp(ary)+1, sv);
 	}
 	if (PL_delaymagic & DM_ARRAY)
-	    mg_set((SV*)ary);
+	    mg_set(MUTABLE_SV(ary));
 
 	PL_delaymagic = 0;
-	SP = ORIGMARK;
-	PUSHi( AvFILLp(ary) + 1 );
+    }
+    SP = ORIGMARK;
+    if (OP_GIMME(PL_op, 0) != G_VOID) {
+	PUSHi( AvFILL(ary) + 1 );
     }
     RETURN;
 }
@@ -4544,7 +4748,7 @@ PP(pp_shift)
 {
     dVAR;
     dSP;
-    AV * const av = (AV*)POPs;
+    AV * const av = MUTABLE_AV(POPs);
     SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
     EXTEND(SP, 1);
     assert (sv);
@@ -4557,11 +4761,11 @@ PP(pp_shift)
 PP(pp_unshift)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    register AV *ary = (AV*)*++MARK;
-    const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
+    register AV *ary = MUTABLE_AV(*++MARK);
+    const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
 
     if (mg) {
-	*MARK-- = SvTIED_obj((SV*)ary, mg);
+	*MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
@@ -4578,24 +4782,85 @@ PP(pp_unshift)
 	}
     }
     SP = ORIGMARK;
-    PUSHi( AvFILL(ary) + 1 );
+    if (OP_GIMME(PL_op, 0) != G_VOID) {
+	PUSHi( AvFILL(ary) + 1 );
+    }
     RETURN;
 }
 
 PP(pp_reverse)
 {
     dVAR; dSP; dMARK;
-    SV ** const oldsp = SP;
 
     if (GIMME == G_ARRAY) {
-	MARK++;
-	while (MARK < SP) {
-	    register SV * const tmp = *MARK;
-	    *MARK++ = *SP;
-	    *SP-- = tmp;
+	if (PL_op->op_private & OPpREVERSE_INPLACE) {
+	    AV *av;
+
+	    /* See pp_sort() */
+	    assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
+	    (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
+	    av = MUTABLE_AV((*SP));
+	    /* In-place reversing only happens in void context for the array
+	     * assignment. We don't need to push anything on the stack. */
+	    SP = MARK;
+
+	    if (SvMAGICAL(av)) {
+		I32 i, j;
+		register SV *tmp = sv_newmortal();
+		/* For SvCANEXISTDELETE */
+		HV *stash;
+		const MAGIC *mg;
+		bool can_preserve = SvCANEXISTDELETE(av);
+
+		for (i = 0, j = av_len(av); i < j; ++i, --j) {
+		    register SV *begin, *end;
+
+		    if (can_preserve) {
+			if (!av_exists(av, i)) {
+			    if (av_exists(av, j)) {
+				register SV *sv = av_delete(av, j, 0);
+				begin = *av_fetch(av, i, TRUE);
+				sv_setsv_mg(begin, sv);
+			    }
+			    continue;
+			}
+			else if (!av_exists(av, j)) {
+			    register SV *sv = av_delete(av, i, 0);
+			    end = *av_fetch(av, j, TRUE);
+			    sv_setsv_mg(end, sv);
+			    continue;
+			}
+		    }
+
+		    begin = *av_fetch(av, i, TRUE);
+		    end   = *av_fetch(av, j, TRUE);
+		    sv_setsv(tmp,      begin);
+		    sv_setsv_mg(begin, end);
+		    sv_setsv_mg(end,   tmp);
+		}
+	    }
+	    else {
+		SV **begin = AvARRAY(av);
+		SV **end   = begin + AvFILLp(av);
+
+		while (begin < end) {
+		    register SV * const tmp = *begin;
+		    *begin++ = *end;
+		    *end--   = tmp;
+		}
+	    }
+	}
+	else {
+	    SV **oldsp = SP;
+	    MARK++;
+	    while (MARK < SP) {
+		register SV * const tmp = *MARK;
+		*MARK++ = *SP;
+		*SP--   = tmp;
+	    }
+	    /* safe as long as stack cannot get extended in the above */
+	    SP = oldsp;
 	}
-	/* safe as long as stack cannot get extended in the above */
-	SP = oldsp;
     }
     else {
 	register char *up;
@@ -4677,11 +4942,13 @@ PP(pp_split)
     I32 iters = 0;
     const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (STRLEN)(strend - s);
     I32 maxiters = slen + 10;
+    I32 trailing_empty = 0;
     const char *orig;
     const I32 origlimit = limit;
     I32 realarray = 0;
     I32 base;
     const I32 gimme = GIMME_V;
+    bool gimme_scalar;
     const I32 oldsave = PL_savestack_ix;
     U32 make_mortal = SVs_TEMP;
     bool multiline = 0;
@@ -4703,15 +4970,13 @@ PP(pp_split)
 
 #ifdef USE_ITHREADS
     if (pm->op_pmreplrootu.op_pmtargetoff) {
-	ary = GvAVn((GV*)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+	ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)));
     }
 #else
     if (pm->op_pmreplrootu.op_pmtargetgv) {
 	ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
     }
 #endif
-    else if (gimme != G_ARRAY)
-	ary = GvAVn(PL_defgv);
     else
 	ary = NULL;
     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
@@ -4720,9 +4985,9 @@ PP(pp_split)
 	av_extend(ary,0);
 	av_clear(ary);
 	SPAGAIN;
-	if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
+	if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
 	    PUSHMARK(SP);
-	    XPUSHs(SvTIED_obj((SV*)ary, mg));
+	    XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
 	}
 	else {
 	    if (!AvREAL(ary)) {
@@ -4757,6 +5022,8 @@ PP(pp_split)
 	multiline = 1;
     }
 
+    gimme_scalar = gimme == G_SCALAR && !ary;
+
     if (!limit)
 	limit = maxiters + 2;
     if (RX_EXTFLAGS(rx) & RXf_WHITE) {
@@ -4782,9 +5049,17 @@ PP(pp_split)
 	    if (m >= strend)
 		break;
 
-	    dstr = newSVpvn_flags(s, m-s,
-				  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
-	    XPUSHs(dstr);
+	    if (gimme_scalar) {
+		iters++;
+		if (m-s == 0)
+		    trailing_empty++;
+		else
+		    trailing_empty = 0;
+	    } else {
+		dstr = newSVpvn_flags(s, m-s,
+				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+		XPUSHs(dstr);
+	    }
 
 	    /* skip the whitespace found last */
 	    if (do_utf8)
@@ -4812,9 +5087,18 @@ PP(pp_split)
 	    m++;
 	    if (m >= strend)
 		break;
-	    dstr = newSVpvn_flags(s, m-s,
-				  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
-	    XPUSHs(dstr);
+
+	    if (gimme_scalar) {
+		iters++;
+		if (m-s == 0)
+		    trailing_empty++;
+		else
+		    trailing_empty = 0;
+	    } else {
+		dstr = newSVpvn_flags(s, m-s,
+				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+		XPUSHs(dstr);
+	    }
 	    s = m;
 	}
     }
@@ -4827,34 +5111,49 @@ PP(pp_split)
             or
           split //, $str, $i;
         */
-        const U32 items = limit - 1; 
-        if (items < slen)
-            EXTEND(SP, items);
-        else
-            EXTEND(SP, slen);
+	if (!gimme_scalar) {
+	    const U32 items = limit - 1;
+	    if (items < slen)
+		EXTEND(SP, items);
+	    else
+		EXTEND(SP, slen);
+	}
 
         if (do_utf8) {
             while (--limit) {
                 /* keep track of how many bytes we skip over */
                 m = s;
                 s += UTF8SKIP(s);
-                dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal);
+		if (gimme_scalar) {
+		    iters++;
+		    if (s-m == 0)
+			trailing_empty++;
+		    else
+			trailing_empty = 0;
+		} else {
+		    dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal);
 
-                PUSHs(dstr);
+		    PUSHs(dstr);
+		}
 
                 if (s >= strend)
                     break;
             }
         } else {
             while (--limit) {
-                dstr = newSVpvn(s, 1);
+	        if (gimme_scalar) {
+		    iters++;
+		} else {
+		    dstr = newSVpvn(s, 1);
 
-                s++;
 
-                if (make_mortal)
-                    sv_2mortal(dstr);
+		    if (make_mortal)
+			sv_2mortal(dstr);
 
-                PUSHs(dstr);
+		    PUSHs(dstr);
+		}
+
+                s++;
 
                 if (s >= strend)
                     break;
@@ -4876,9 +5175,17 @@ PP(pp_split)
 		    ;
 		if (m >= strend)
 		    break;
-		dstr = newSVpvn_flags(s, m-s,
-				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
-		XPUSHs(dstr);
+		if (gimme_scalar) {
+		    iters++;
+		    if (m-s == 0)
+			trailing_empty++;
+		    else
+			trailing_empty = 0;
+		} else {
+		    dstr = newSVpvn_flags(s, m-s,
+					  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+		    XPUSHs(dstr);
+		}
 		/* The rx->minlen is in characters but we want to step
 		 * s ahead by bytes. */
  		if (do_utf8)
@@ -4892,9 +5199,17 @@ PP(pp_split)
 	      (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
 			     csv, multiline ? FBMrf_MULTILINE : 0)) )
 	    {
-		dstr = newSVpvn_flags(s, m-s,
-				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
-		XPUSHs(dstr);
+		if (gimme_scalar) {
+		    iters++;
+		    if (m-s == 0)
+			trailing_empty++;
+		    else
+			trailing_empty = 0;
+		} else {
+		    dstr = newSVpvn_flags(s, m-s,
+					  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+		    XPUSHs(dstr);
+		}
 		/* The rx->minlen is in characters but we want to step
 		 * s ahead by bytes. */
  		if (do_utf8)
@@ -4924,9 +5239,18 @@ PP(pp_split)
 		strend = s + (strend - m);
 	    }
 	    m = RX_OFFS(rx)[0].start + orig;
-	    dstr = newSVpvn_flags(s, m-s,
-				  (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
-	    XPUSHs(dstr);
+
+	    if (gimme_scalar) {
+		iters++;
+		if (m-s == 0)
+		    trailing_empty++;
+		else
+		    trailing_empty = 0;
+	    } else {
+		dstr = newSVpvn_flags(s, m-s,
+				      (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+		XPUSHs(dstr);
+	    }
 	    if (RX_NPARENS(rx)) {
 		I32 i;
 		for (i = 1; i <= (I32)RX_NPARENS(rx); i++) {
@@ -4936,37 +5260,54 @@ PP(pp_split)
 		    /* japhy (07/27/01) -- the (m && s) test doesn't catch
 		       parens that didn't match -- they should be set to
 		       undef, not the empty string */
-		    if (m >= orig && s >= orig) {
-			dstr = newSVpvn_flags(s, m-s,
-					     (do_utf8 ? SVf_UTF8 : 0)
-					      | make_mortal);
+		    if (gimme_scalar) {
+			iters++;
+			if (m-s == 0)
+			    trailing_empty++;
+			else
+			    trailing_empty = 0;
+		    } else {
+			if (m >= orig && s >= orig) {
+			    dstr = newSVpvn_flags(s, m-s,
+						 (do_utf8 ? SVf_UTF8 : 0)
+						  | make_mortal);
+			}
+			else
+			    dstr = &PL_sv_undef;  /* undef, not "" */
+			XPUSHs(dstr);
 		    }
-		    else
-			dstr = &PL_sv_undef;  /* undef, not "" */
-		    XPUSHs(dstr);
+
 		}
 	    }
 	    s = RX_OFFS(rx)[0].end + orig;
 	}
     }
 
-    iters = (SP - PL_stack_base) - base;
+    if (!gimme_scalar) {
+	iters = (SP - PL_stack_base) - base;
+    }
     if (iters > maxiters)
 	DIE(aTHX_ "Split loop");
 
     /* keep field after final delim? */
     if (s < strend || (iters && origlimit)) {
-        const STRLEN l = strend - s;
-	dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
-	XPUSHs(dstr);
+	if (!gimme_scalar) {
+	    const STRLEN l = strend - s;
+	    dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
+	    XPUSHs(dstr);
+	}
 	iters++;
     }
     else if (!origlimit) {
-	while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
-	    if (TOPs && !make_mortal)
-		sv_2mortal(TOPs);
-	    iters--;
-	    *SP-- = &PL_sv_undef;
+	if (gimme_scalar) {
+	    iters -= trailing_empty;
+	} else {
+	    while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
+		if (TOPs && !make_mortal)
+		    sv_2mortal(TOPs);
+		*SP-- = &PL_sv_undef;
+		iters--;
+	    }
 	}
     }
 
@@ -4977,7 +5318,7 @@ PP(pp_split)
 	if (!mg) {
 	    if (SvSMAGICAL(ary)) {
 		PUTBACK;
-		mg_set((SV*)ary);
+		mg_set(MUTABLE_SV(ary));
 		SPAGAIN;
 	    }
 	    if (gimme == G_ARRAY) {
@@ -5034,9 +5375,9 @@ PP(pp_lock)
     dSP;
     dTOPss;
     SV *retsv = sv;
+    assert(SvTYPE(retsv) != SVt_PVCV);
     SvLOCK(sv);
-    if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
-	|| SvTYPE(retsv) == SVt_PVCV) {
+    if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV) {
 	retsv = refto(retsv);
     }
     SETs(retsv);
@@ -5049,6 +5390,25 @@ PP(unimplemented_op)
     dVAR;
     DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
 	PL_op->op_type);
+    return NORMAL;
+}
+
+PP(pp_boolkeys)
+{
+    dVAR;
+    dSP;
+    HV * const hv = (HV*)POPs;
+    
+    if (SvRMAGICAL(hv)) {
+	MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+	if (mg) {
+            XPUSHs(magic_scalarpack(hv, mg));
+	    RETURN;
+        }	    
+    }
+
+    XPUSHs(boolSV(HvKEYS(hv) != 0));
+    RETURN;
 }
 
 /*