X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1cd88304d705aae8d2b32c6e925fedd52980a122..cea80896350bf9218a73437b32b19656cee32abd:/pp.c

diff --git a/pp.c b/pp.c
index 9b8dd90..621377f 100644
--- a/pp.c
+++ b/pp.c
@@ -62,6 +62,7 @@ PP(pp_stub)
 
 /* Pushy stuff. */
 
+/* This is also called directly by pp_lvavref.  */
 PP(pp_padav)
 {
     dSP; dTARGET;
@@ -249,6 +250,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
 			const char * const name = CopSTASHPV(PL_curcop);
 			gv = newGVgen_flags(name,
                                 HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 );
+			SvREFCNT_inc_simple_void_NN(gv);
 		    }
 		    prepare_SV_for_RV(sv);
 		    SvRV_set(sv, MUTABLE_SV(gv));
@@ -416,12 +418,12 @@ PP(pp_av2arylen)
     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);
+	SV ** const svp = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
+	if (!*svp) {
+	    *svp = newSV_type(SVt_PVMG);
+	    sv_magic(*svp, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
 	}
-	SETs(*sv);
+	SETs(*svp);
     } else {
 	SETs(sv_2mortal(newSViv(AvFILL(MUTABLE_AV(av)))));
     }
@@ -471,7 +473,9 @@ PP(pp_rv2cv)
     CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags);
     if (cv) NOOP;
     else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) {
-	cv = MUTABLE_CV(gv);
+	cv = SvTYPE(SvRV(gv)) == SVt_PVCV
+	    ? MUTABLE_CV(SvRV(gv))
+	    : MUTABLE_CV(gv);
     }    
     else
 	cv = MUTABLE_CV(&PL_sv_undef);
@@ -570,7 +574,6 @@ S_refto(pTHX_ SV *sv)
 	SvREFCNT_inc_void_NN(sv);
     }
     else if (SvPADTMP(sv)) {
-        assert(!IS_PADGV(sv));
         sv = newSVsv(sv);
     }
     else {
@@ -739,6 +742,9 @@ PP(pp_study)
     RETPUSHYES;
 }
 
+
+/* also used for: pp_transr() */
+
 PP(pp_trans)
 {
     dSP; dTARG;
@@ -746,7 +752,7 @@ PP(pp_trans)
 
     if (PL_op->op_flags & OPf_STACKED)
 	sv = POPs;
-    else if (PL_op->op_private & OPpTARGET_MY)
+    else if (ARGTARG)
 	sv = GETTARGET;
     else {
 	sv = DEFSV;
@@ -768,16 +774,17 @@ PP(pp_trans)
 
 /* Lvalue operators. */
 
-static void
+static size_t
 S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 {
     STRLEN len;
     char *s;
+    size_t count = 0;
 
     PERL_ARGS_ASSERT_DO_CHOMP;
 
     if (chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs)))
-	return;
+	return 0;
     if (SvTYPE(sv) == SVt_PVAV) {
 	I32 i;
 	AV *const av = MUTABLE_AV(sv);
@@ -786,33 +793,30 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 	for (i = 0; i <= max; i++) {
 	    sv = MUTABLE_SV(av_fetch(av, i, FALSE));
 	    if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
-		do_chomp(retval, sv, chomping);
+		count += do_chomp(retval, sv, chomping);
 	}
-        return;
+        return count;
     }
     else if (SvTYPE(sv) == SVt_PVHV) {
 	HV* const hv = MUTABLE_HV(sv);
 	HE* entry;
         (void)hv_iterinit(hv);
         while ((entry = hv_iternext(hv)))
-            do_chomp(retval, hv_iterval(hv,entry), chomping);
-	return;
+            count += do_chomp(retval, hv_iterval(hv,entry), chomping);
+	return count;
     }
     else if (SvREADONLY(sv)) {
             Perl_croak_no_modify();
     }
-    else if (SvIsCOW(sv)) {
-	sv_force_normal_flags(sv, 0);
-    }
 
-    if (PL_encoding) {
+    if (IN_ENCODING) {
 	if (!SvUTF8(sv)) {
 	    /* XXX, here sv is utf8-ized as a side-effect!
 	       If encoding.pm is used properly, almost string-generating
 	       operations, including literal strings, chr(), input data, etc.
 	       should have been utf8-ized already, right?
 	    */
-	    sv_recode_to_utf8(sv, PL_encoding);
+	    sv_recode_to_utf8(sv, _get_encoding());
 	}
     }
 
@@ -826,11 +830,11 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 	    if (RsPARA(PL_rs)) {
 		if (*s != '\n')
 		    goto nope;
-		++SvIVX(retval);
+		++count;
 		while (len && s[-1] == '\n') {
 		    --len;
 		    --s;
-		    ++SvIVX(retval);
+		    ++count;
 		}
 	    }
 	    else {
@@ -857,11 +861,11 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 			}
 			rsptr = temp_buffer;
 		    }
-		    else if (PL_encoding) {
+		    else if (IN_ENCODING) {
 			/* RS is 8 bit, encoding.pm is used.
 			 * Do not recode PL_rs as a side-effect. */
 			svrecode = newSVpvn(rsptr, rslen);
-			sv_recode_to_utf8(svrecode, PL_encoding);
+			sv_recode_to_utf8(svrecode, _get_encoding());
 			rsptr = SvPV_const(svrecode, rslen);
 			rs_charlen = sv_len_utf8(svrecode);
 		    }
@@ -874,7 +878,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 		if (rslen == 1) {
 		    if (*s != *rsptr)
 			goto nope;
-		    ++SvIVX(retval);
+		    ++count;
 		}
 		else {
 		    if (len < rslen - 1)
@@ -883,10 +887,10 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 		    s -= rslen - 1;
 		    if (memNE(s, rsptr, rslen))
 			goto nope;
-		    SvIVX(retval) += rs_charlen;
+		    count += rs_charlen;
 		}
 	    }
-	    s = SvPV_force_nomg_nolen(sv);
+	    SvPV_force_nomg_nolen(sv);
 	    SvCUR_set(sv, len);
 	    *SvEND(sv) = '\0';
 	    SvNIOK_off(sv);
@@ -898,7 +902,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 
 	Safefree(temp_buffer);
     } else {
-	if (len && !SvPOK(sv))
+	if (len && (!SvPOK(sv) || SvIsCOW(sv)))
 	    s = SvPV_force_nomg(sv, len);
 	if (DO_UTF8(sv)) {
 	    if (s && len) {
@@ -930,29 +934,37 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
 	    sv_setpvs(retval, "");
 	SvSETMAGIC(sv);
     }
+    return count;
 }
 
+
+/* also used for: pp_schomp() */
+
 PP(pp_schop)
 {
     dSP; dTARGET;
     const bool chomping = PL_op->op_type == OP_SCHOMP;
 
+    const size_t count = do_chomp(TARG, TOPs, chomping);
     if (chomping)
-	sv_setiv(TARG, 0);
-    do_chomp(TARG, TOPs, chomping);
+	sv_setiv(TARG, count);
     SETTARG;
     RETURN;
 }
 
+
+/* also used for: pp_chomp() */
+
 PP(pp_chop)
 {
     dSP; dMARK; dTARGET; dORIGMARK;
     const bool chomping = PL_op->op_type == OP_CHOMP;
+    size_t count = 0;
 
-    if (chomping)
-	sv_setiv(TARG, 0);
     while (MARK < SP)
-	do_chomp(TARG, *++MARK, chomping);
+	count += do_chomp(TARG, *++MARK, chomping);
+    if (chomping)
+	sv_setiv(TARG, count);
     SP = ORIGMARK;
     XPUSHTARG;
     RETURN;
@@ -972,7 +984,8 @@ PP(pp_undef)
     if (!sv)
 	RETPUSHUNDEF;
 
-    SV_CHECK_THINKFIRST_COW_DROP(sv);
+    if (SvTHINKFIRST(sv))
+	sv_force_normal_flags(sv, SV_COW_DROP_PV|SV_IMMEDIATE_UNREF);
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -997,18 +1010,8 @@ PP(pp_undef)
                            ));
 	/* FALLTHROUGH */
     case SVt_PVFM:
-	{
 	    /* let user-undef'd sub keep its identity */
-	    GV* const gv = CvGV((const CV *)sv);
-	    HEK * const hek = CvNAME_HEK((CV *)sv);
-	    if (hek) share_hek_hek(hek);
-	    cv_undef(MUTABLE_CV(sv));
-	    if (gv) CvGV_set(MUTABLE_CV(sv), gv);
-	    else if (hek) {
-		SvANY((CV *)sv)->xcv_gv_u.xcv_hek = hek;
-		CvNAMED_on(sv);
-	    }
-	}
+	cv_undef_flags(MUTABLE_CV(sv), CV_UNDEF_KEEP_NAME);
 	break;
     case SVt_PVGV:
 	assert(isGV_with_GP(sv));
@@ -1067,6 +1070,9 @@ PP(pp_undef)
     RETPUSHUNDEF;
 }
 
+
+/* also used for: pp_i_postdec() pp_i_postinc() pp_postdec() */
+
 PP(pp_postinc)
 {
     dSP; dTARGET;
@@ -1090,7 +1096,7 @@ PP(pp_postinc)
     /* special case for undef: see thread at 2003-03/msg00536.html in archive */
     if (inc && !SvOK(TARG))
 	sv_setiv(TARG, 0);
-    SETs(TARG);
+    SETTARG;
     return NORMAL;
 }
 
@@ -1644,6 +1650,25 @@ PP(pp_repeat)
 	SvGETMAGIC(sv);
     }
     else {
+	if (UNLIKELY(PL_op->op_private & OPpREPEAT_DOLIST)) {
+	    /* The parser saw this as a list repeat, and there
+	       are probably several items on the stack. But we're
+	       in scalar/void context, and there's no pp_list to save us
+	       now. So drop the rest of the items -- robin@kitsite.com
+	     */
+	    dMARK;
+	    if (MARK + 1 < SP) {
+		MARK[1] = TOPm1s;
+		MARK[2] = TOPs;
+	    }
+	    else {
+		dTOPss;
+		ASSUME(MARK + 1 == SP);
+		XPUSHs(sv);
+		MARK[1] = &PL_sv_undef;
+	    }
+	    SP = MARK + 2;
+	}
 	tryAMAGICbin_MG(repeat_amg, AMGf_assign);
 	sv = POPs;
     }
@@ -1689,38 +1714,12 @@ PP(pp_repeat)
 	MEXTEND(MARK, max);
 	if (count > 1) {
 	    while (SP > MARK) {
-#if 0
-	      /* This code was intended to fix 20010809.028:
-
-	         $x = 'abcd';
-		 for (($x =~ /./g) x 2) {
-		     print chop; # "abcdabcd" expected as output.
-		 }
-
-	       * but that change (#11635) broke this code:
-
-	       $x = [("foo")x2]; # only one "foo" ended up in the anonlist.
-
-	       * I can't think of a better fix that doesn't introduce
-	       * an efficiency hit by copying the SVs. The stack isn't
-	       * refcounted, and mortalisation obviously doesn't
-	       * Do The Right Thing when the stack has more than
-	       * one pointer to the same mortal value.
-	       * .robin.
-	       */
-		if (*SP) {
-		    *SP = sv_2mortal(newSVsv(*SP));
-		    SvREADONLY_on(*SP);
-		}
-#else
                 if (*SP) {
                    if (mod && SvPADTMP(*SP)) {
-                       assert(!IS_PADGV(*SP));
                        *SP = sv_mortalcopy(*SP);
                    }
 		   SvTEMP_off((*SP));
 		}
-#endif
 		SP--;
 	    }
 	    MARK++;
@@ -1761,15 +1760,6 @@ PP(pp_repeat)
 	else
 	    (void)SvPOK_only(TARG);
 
-	if (PL_op->op_private & OPpREPEAT_DOLIST) {
-	    /* The parser saw this as a list repeat, and there
-	       are probably several items on the stack. But we're
-	       in scalar context, and there's no pp_list to save us
-	       now. So drop the rest of the items -- robin@kitsite.com
-	     */
-	    dMARK;
-	    SP = MARK;
-	}
 	PUSHTARG;
     }
     RETURN;
@@ -2105,6 +2095,9 @@ PP(pp_ncmp)
     RETURN;
 }
 
+
+/* also used for: pp_sge() pp_sgt() pp_slt() */
+
 PP(pp_sle)
 {
     dSP;
@@ -2215,6 +2208,9 @@ PP(pp_bit_and)
     }
 }
 
+
+/* also used for: pp_bit_xor() */
+
 PP(pp_bit_or)
 {
     dSP; dATARGET;
@@ -2681,48 +2677,51 @@ PP(pp_atan2)
     }
 }
 
+
+/* also used for: pp_cos() pp_exp() pp_log() pp_sqrt() */
+
 PP(pp_sin)
 {
     dSP; dTARGET;
-    int amg_type = sin_amg;
+    int amg_type = fallback_amg;
     const char *neg_report = NULL;
-    NV (*func)(NV) = Perl_sin;
     const int op_type = PL_op->op_type;
 
     switch (op_type) {
-    case OP_COS:
-	amg_type = cos_amg;
-	func = Perl_cos;
-	break;
-    case OP_EXP:
-	amg_type = exp_amg;
-	func = Perl_exp;
-	break;
-    case OP_LOG:
-	amg_type = log_amg;
-	func = Perl_log;
-	neg_report = "log";
-	break;
-    case OP_SQRT:
-	amg_type = sqrt_amg;
-	func = Perl_sqrt;
-	neg_report = "sqrt";
-	break;
+    case OP_SIN:  amg_type = sin_amg; break;
+    case OP_COS:  amg_type = cos_amg; break;
+    case OP_EXP:  amg_type = exp_amg; break;
+    case OP_LOG:  amg_type = log_amg;  neg_report = "log";  break;
+    case OP_SQRT: amg_type = sqrt_amg; neg_report = "sqrt"; break;
     }
 
+    assert(amg_type != fallback_amg);
 
     tryAMAGICun_MG(amg_type, 0);
     {
       SV * const arg = POPs;
       const NV value = SvNV_nomg(arg);
-      if (neg_report) {
-	  if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) {
+      NV result = NV_NAN;
+      if (neg_report) { /* log or sqrt */
+	  if (
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+	      ! Perl_isnan(value) &&
+#endif
+	      (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0))) {
 	      SET_NUMERIC_STANDARD();
 	      /* diag_listed_as: Can't take log of %g */
 	      DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
 	  }
       }
-      XPUSHn(func(value));
+      switch (op_type) {
+      default:
+      case OP_SIN:  result = Perl_sin(value);  break;
+      case OP_COS:  result = Perl_cos(value);  break;
+      case OP_EXP:  result = Perl_exp(value);  break;
+      case OP_LOG:  result = Perl_log(value);  break;
+      case OP_SQRT: result = Perl_sqrt(value); break;
+      }
+      XPUSHn(result);
       RETURN;
     }
 }
@@ -2759,7 +2758,11 @@ PP(pp_rand)
 		value = SvNV(sv);
 	}
     /* 1 of 2 things can be carried through SvNV, SP or TARG, SP was carried */
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+	if (! Perl_isnan(value) && value == 0.0)
+#else
 	if (value == 0.0)
+#endif
 	    value = 1.0;
 	{
 	    dTARGET;
@@ -2833,7 +2836,9 @@ PP(pp_int)
       }
       else {
 	  const NV value = SvNV_nomg(sv);
-	  if (value >= 0.0) {
+          if (SvNOK(sv) && UNLIKELY(Perl_isinfnan(SvNV(sv))))
+              SETn(SvNV(sv));
+	  else if (value >= 0.0) {
 	      if (value < (NV)UV_MAX + 0.5) {
 		  SETu(U_V(value));
 	      } else {
@@ -2892,6 +2897,9 @@ PP(pp_abs)
     RETURN;
 }
 
+
+/* also used for: pp_hex() */
+
 PP(pp_oct)
 {
     dSP; dTARGET;
@@ -2944,24 +2952,45 @@ PP(pp_length)
     dSP; dTARGET;
     SV * const sv = TOPs;
 
-    SvGETMAGIC(sv);
+    U32 in_bytes = IN_BYTES;
+    /* simplest case shortcut */
+    /* turn off SVf_UTF8 in tmp flags if HINT_BYTES on*/
+    U32 svflags = (SvFLAGS(sv) ^ (in_bytes << 26)) & (SVf_POK|SVs_GMG|SVf_UTF8);
+    assert(HINT_BYTES == 0x00000008 && SVf_UTF8 == 0x20000000 && (SVf_UTF8 == HINT_BYTES << 26));
+    SETs(TARG);
+
+    if(LIKELY(svflags == SVf_POK))
+        goto simple_pv;
+    if(svflags & SVs_GMG)
+        mg_get(sv);
     if (SvOK(sv)) {
-	if (!IN_BYTES)
-	    SETi(sv_len_utf8_nomg(sv));
+	if (!IN_BYTES) /* reread to avoid using an C auto/register */
+	    sv_setiv(TARG, (IV)sv_len_utf8_nomg(sv));
 	else
 	{
 	    STRLEN len;
-	    (void)SvPV_nomg_const(sv,len);
-	    SETi(len);
+            /* unrolled SvPV_nomg_const(sv,len) */
+            if(SvPOK_nog(sv)){
+                simple_pv:
+                len = SvCUR(sv);
+            } else  {
+                (void)sv_2pv_flags(sv, &len, 0|SV_CONST_RETURN);
+            }
+	    sv_setiv(TARG, (IV)(len));
 	}
     } else {
 	if (!SvPADTMP(TARG)) {
 	    sv_setsv_nomg(TARG, &PL_sv_undef);
-	    SETTARG;
-	}
-	SETs(&PL_sv_undef);
+	} else { /* TARG is on stack at this point and is overwriten by SETs.
+                   This branch is the odd one out, so put TARG by default on
+                   stack earlier to let local SP go out of liveness sooner */
+            SETs(&PL_sv_undef);
+            goto no_set_magic;
+        }
     }
-    RETURN;
+    SvSETMAGIC(TARG);
+    no_set_magic:
+    return NORMAL; /* no putback, SP didn't move in this opcode */
 }
 
 /* Returns false if substring is completely outside original string.
@@ -3157,7 +3186,9 @@ PP(pp_substr)
 	}
     }
     SPAGAIN;
-    if (rvalue) {
+    if (PL_op->op_private & OPpSUBSTR_REPL_FIRST)
+	SP++;
+    else if (rvalue) {
 	SvSETMAGIC(TARG);
 	PUSHs(TARG);
     }
@@ -3194,10 +3225,15 @@ PP(pp_vec)
     }
 
     sv_setuv(ret, do_vecget(src, offset, size));
+    if (!lvalue)
+	SvSETMAGIC(ret);
     PUSHs(ret);
     RETURN;
 }
 
+
+/* also used for: pp_rindex() */
+
 PP(pp_index)
 {
     dSP; dTARGET;
@@ -3226,7 +3262,7 @@ PP(pp_index)
     little_utf8 = DO_UTF8(little);
     if (big_utf8 ^ little_utf8) {
 	/* One needs to be upgraded.  */
-	if (little_utf8 && !PL_encoding) {
+	if (little_utf8 && !IN_ENCODING) {
 	    /* Well, maybe instead we might be able to downgrade the small
 	       string?  */
 	    char * const pv = (char*)bytes_from_utf8((U8 *)little_p, &llen,
@@ -3248,8 +3284,8 @@ PP(pp_index)
 	    temp = little_utf8
 		? newSVpvn(big_p, biglen) : newSVpvn(little_p, llen);
 
-	    if (PL_encoding) {
-		sv_recode_to_utf8(temp, PL_encoding);
+	    if (IN_ENCODING) {
+		sv_recode_to_utf8(temp, _get_encoding());
 	    } else {
 		sv_utf8_upgrade(temp);
 	    }
@@ -3334,9 +3370,9 @@ PP(pp_ord)
     STRLEN len;
     const U8 *s = (U8*)SvPV_const(argsv, len);
 
-    if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) {
+    if (IN_ENCODING && SvPOK(argsv) && !DO_UTF8(argsv)) {
         SV * const tmpsv = sv_2mortal(newSVsv(argsv));
-        s = (U8*)sv_recode_to_utf8(tmpsv, PL_encoding);
+        s = (U8*)sv_recode_to_utf8(tmpsv, _get_encoding());
         len = UTF8SKIP(s);  /* Should be well-formed; so this is its length */
         argsv = tmpsv;
     }
@@ -3356,13 +3392,8 @@ PP(pp_chr)
     SV *top = POPs;
 
     SvGETMAGIC(top);
-    if (SvNOK(top) && Perl_isinfnan(SvNV(top))) {
-        if (ckWARN(WARN_UTF8)) {
-            Perl_warner(aTHX_ packWARN(WARN_UTF8),
-                        "Invalid number (%"NVgf") in chr", SvNV(top));
-        }
-        value = UNICODE_REPLACEMENT;
-    }
+    if (UNLIKELY(isinfnansv(top)))
+        Perl_croak(aTHX_ "Cannot chr %"NVgf, SvNV(top));
     else {
         if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
             && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
@@ -3393,7 +3424,7 @@ PP(pp_chr)
 	*tmps = '\0';
 	(void)SvPOK_only(TARG);
 	SvUTF8_on(TARG);
-	XPUSHs(TARG);
+	XPUSHTARG;
 	RETURN;
     }
 
@@ -3404,8 +3435,8 @@ PP(pp_chr)
     *tmps = '\0';
     (void)SvPOK_only(TARG);
 
-    if (PL_encoding && !IN_BYTES) {
-        sv_recode_to_utf8(TARG, PL_encoding);
+    if (IN_ENCODING && !IN_BYTES) {
+        sv_recode_to_utf8(TARG, _get_encoding());
 	tmps = SvPVX(TARG);
 	if (SvCUR(TARG) == 0
 	    || ! is_utf8_string((U8*)tmps, SvCUR(TARG))
@@ -3420,7 +3451,7 @@ PP(pp_chr)
 	}
     }
 
-    XPUSHs(TARG);
+    XPUSHTARG;
     RETURN;
 }
 
@@ -3436,9 +3467,8 @@ PP(pp_crypt)
          /* If Unicode, try to downgrade.
 	  * If not possible, croak.
 	  * Yes, we made this up.  */
-	 SV* const tsv = sv_2mortal(newSVsv(left));
+	 SV* const tsv = newSVpvn_flags(tmps, len, SVf_UTF8|SVs_TEMP);
 
-	 SvUTF8_on(tsv);
 	 sv_utf8_downgrade(tsv, FALSE);
 	 tmps = SvPV_const(tsv, len);
     }
@@ -3465,6 +3495,7 @@ PP(pp_crypt)
 #   else
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
 #   endif
+    SvUTF8_off(TARG);
     SETTARG;
     RETURN;
 #else
@@ -3476,6 +3507,9 @@ PP(pp_crypt)
 /* Generally UTF-8 and UTF-EBCDIC are indistinguishable at this level.  So 
  * most comments below say UTF-8, when in fact they mean UTF-EBCDIC as well */
 
+
+/* also used for: pp_lcfirst() */
+
 PP(pp_ucfirst)
 {
     /* Actually is both lcfirst() and ucfirst().  Only the first character
@@ -4464,7 +4498,11 @@ PP(pp_kvaslice)
     RETURN;
 }
 
+
 /* Smart dereferencing for keys, values and each */
+
+/* also used for: pp_reach() pp_rvalues() */
+
 PP(pp_rkeys)
 {
     dSP;
@@ -4527,6 +4565,7 @@ PP(pp_aeach)
     RETURN;
 }
 
+/* also used for: pp_avalues()*/
 PP(pp_akeys)
 {
     dSP;
@@ -4968,7 +5007,6 @@ PP(pp_lslice)
 	    if (!(*lelem = firstrelem[ix]))
 		*lelem = &PL_sv_undef;
 	    else if (mod && SvPADTMP(*lelem)) {
-                assert(!IS_PADGV(*lelem));
 		*lelem = firstrelem[ix] = sv_mortalcopy(*lelem);
             }
 	}
@@ -5300,6 +5338,7 @@ PP(pp_push)
     RETURN;
 }
 
+/* also used for: pp_pop()*/
 PP(pp_shift)
 {
     dSP;
@@ -5478,7 +5517,7 @@ PP(pp_reverse)
 PP(pp_split)
 {
     dSP; dTARG;
-    AV *ary;
+    AV *ary = PL_op->op_flags & OPf_STACKED ? (AV *)POPs : NULL;
     IV limit = POPi;			/* note, negative is forever */
     SV * const sv = POPs;
     STRLEN len;
@@ -5511,7 +5550,7 @@ PP(pp_split)
 #else
     pm = (PMOP*)POPs;
 #endif
-    if (!pm || !s)
+    if (!pm)
 	DIE(aTHX_ "panic: pp_split, pm=%p, s=%p", pm, s);
     rx = PM_GETRE(pm);
 
@@ -5527,12 +5566,13 @@ PP(pp_split)
 	ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
     }
 #endif
-    else
-	ary = NULL;
+    else if (pm->op_targ)
+	ary = (AV *)PAD_SVl(pm->op_targ);
     if (ary) {
 	realarray = 1;
 	PUTBACK;
 	av_extend(ary,0);
+	(void)sv_2mortal(SvREFCNT_inc_simple_NN(sv));
 	av_clear(ary);
 	SPAGAIN;
 	if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
@@ -5934,6 +5974,9 @@ PP(pp_lock)
 }
 
 
+/* used for: pp_padany(), pp_mapstart(), pp_custom(); plus any system ops
+ * that aren't implemented on a particular platform */
+
 PP(unimplemented_op)
 {
     const Optype op_type = PL_op->op_type;
@@ -6108,6 +6151,210 @@ PP(pp_runcv)
     RETURN;
 }
 
+static void
+S_localise_aelem_lval(pTHX_ AV * const av, SV * const keysv,
+			    const bool can_preserve)
+{
+    const SSize_t ix = SvIV(keysv);
+    if (can_preserve ? av_exists(av, ix) : TRUE) {
+	SV ** const svp = av_fetch(av, ix, 1);
+	if (!svp || !*svp)
+	    Perl_croak(aTHX_ PL_no_aelem, ix);
+	save_aelem(av, ix, svp);
+    }
+    else
+	SAVEADELETE(av, ix);
+}
+
+static void
+S_localise_helem_lval(pTHX_ HV * const hv, SV * const keysv,
+			    const bool can_preserve)
+{
+    if (can_preserve ? hv_exists_ent(hv, keysv, 0) : TRUE) {
+	HE * const he = hv_fetch_ent(hv, keysv, 1, 0);
+	SV ** const svp = he ? &HeVAL(he) : NULL;
+	if (!svp || !*svp)
+	    Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+	save_helem_flags(hv, keysv, svp, 0);
+    }
+    else
+	SAVEHDELETE(hv, keysv);
+}
+
+static void
+S_localise_gv_slot(pTHX_ GV *gv, U8 type)
+{
+    if (type == OPpLVREF_SV) {
+	save_pushptrptr(gv, SvREFCNT_inc_simple(GvSV(gv)), SAVEt_GVSV);
+	GvSV(gv) = 0;
+    }
+    else if (type == OPpLVREF_AV)
+	/* XXX Inefficient, as it creates a new AV, which we are
+	       about to clobber.  */
+	save_ary(gv);
+    else {
+	assert(type == OPpLVREF_HV);
+	/* XXX Likewise inefficient.  */
+	save_hash(gv);
+    }
+}
+
+
+PP(pp_refassign)
+{
+    dSP;
+    SV * const key = PL_op->op_private & OPpLVREF_ELEM ? POPs : NULL;
+    SV * const left = PL_op->op_flags & OPf_STACKED ? POPs : NULL;
+    dTOPss;
+    const char *bad = NULL;
+    const U8 type = PL_op->op_private & OPpLVREF_TYPE;
+    if (!SvROK(sv)) DIE(aTHX_ "Assigned value is not a reference");
+    switch (type) {
+    case OPpLVREF_SV:
+	if (SvTYPE(SvRV(sv)) > SVt_PVLV)
+	    bad = " SCALAR";
+	break;
+    case OPpLVREF_AV:
+	if (SvTYPE(SvRV(sv)) != SVt_PVAV)
+	    bad = "n ARRAY";
+	break;
+    case OPpLVREF_HV:
+	if (SvTYPE(SvRV(sv)) != SVt_PVHV)
+	    bad = " HASH";
+	break;
+    case OPpLVREF_CV:
+	if (SvTYPE(SvRV(sv)) != SVt_PVCV)
+	    bad = " CODE";
+    }
+    if (bad)
+	/* diag_listed_as: Assigned value is not %s reference */
+	DIE(aTHX_ "Assigned value is not a%s reference", bad);
+    switch (left ? SvTYPE(left) : 0) {
+	MAGIC *mg;
+	HV *stash;
+    case 0:
+    {
+	SV * const old = PAD_SV(ARGTARG);
+	PAD_SETSV(ARGTARG, SvREFCNT_inc_NN(SvRV(sv)));
+	SvREFCNT_dec(old);
+	if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
+		== OPpLVAL_INTRO)
+	    SAVECLEARSV(PAD_SVl(ARGTARG));
+	break;
+    }
+    case SVt_PVGV:
+	if (PL_op->op_private & OPpLVAL_INTRO) {
+	    S_localise_gv_slot(aTHX_ (GV *)left, type);
+	}
+	gv_setref(left, sv);
+	SvSETMAGIC(left);
+	break;
+    case SVt_PVAV:
+	if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
+	    S_localise_aelem_lval(aTHX_ (AV *)left, key,
+					SvCANEXISTDELETE(left));
+	}
+	av_store((AV *)left, SvIV(key), SvREFCNT_inc_simple_NN(SvRV(sv)));
+	break;
+    case SVt_PVHV:
+	if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO))
+	    S_localise_helem_lval(aTHX_ (HV *)left, key,
+					SvCANEXISTDELETE(left));
+	(void)hv_store_ent((HV *)left, key, SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
+    }
+    if (PL_op->op_flags & OPf_MOD)
+	SETs(sv_2mortal(newSVsv(sv)));
+    /* XXX else can weak references go stale before they are read, e.g.,
+       in leavesub?  */
+    RETURN;
+}
+
+PP(pp_lvref)
+{
+    dSP;
+    SV * const ret = sv_2mortal(newSV_type(SVt_PVMG));
+    SV * const elem = PL_op->op_private & OPpLVREF_ELEM ? POPs : NULL;
+    SV * const arg = PL_op->op_flags & OPf_STACKED ? POPs : NULL;
+    MAGIC * const mg = sv_magicext(ret, arg, PERL_MAGIC_lvref,
+				   &PL_vtbl_lvref, (char *)elem,
+				   elem ? HEf_SVKEY : (I32)ARGTARG);
+    mg->mg_private = PL_op->op_private;
+    if (PL_op->op_private & OPpLVREF_ITER)
+	mg->mg_flags |= MGf_PERSIST;
+    if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
+      if (elem) {
+	MAGIC *mg;
+	HV *stash;
+	const bool can_preserve = SvCANEXISTDELETE(arg);
+	if (SvTYPE(arg) == SVt_PVAV)
+	    S_localise_aelem_lval(aTHX_ (AV *)arg, elem, can_preserve);
+	else
+	    S_localise_helem_lval(aTHX_ (HV *)arg, elem, can_preserve);
+      }
+      else if (arg) {
+	S_localise_gv_slot(aTHX_ (GV *)arg, 
+				 PL_op->op_private & OPpLVREF_TYPE);
+      }
+      else if (!(PL_op->op_private & OPpPAD_STATE))
+	SAVECLEARSV(PAD_SVl(ARGTARG));
+    }
+    XPUSHs(ret);
+    RETURN;
+}
+
+PP(pp_lvrefslice)
+{
+    dSP; dMARK;
+    AV * const av = (AV *)POPs;
+    const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+    bool can_preserve = FALSE;
+
+    if (UNLIKELY(localizing)) {
+	MAGIC *mg;
+	HV *stash;
+	SV **svp;
+
+	can_preserve = SvCANEXISTDELETE(av);
+
+	if (SvTYPE(av) == SVt_PVAV) {
+	    SSize_t max = -1;
+
+	    for (svp = MARK + 1; svp <= SP; svp++) {
+		const SSize_t elem = SvIV(*svp);
+		if (elem > max)
+		    max = elem;
+	    }
+	    if (max > AvMAX(av))
+		av_extend(av, max);
+	}
+    }
+
+    while (++MARK <= SP) {
+	SV * const elemsv = *MARK;
+	if (SvTYPE(av) == SVt_PVAV)
+	    S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
+	else
+	    S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
+	*MARK = sv_2mortal(newSV_type(SVt_PVMG));
+	sv_magic(*MARK,(SV *)av,PERL_MAGIC_lvref,(char *)elemsv,HEf_SVKEY);
+    }
+    RETURN;
+}
+
+PP(pp_lvavref)
+{
+    if (PL_op->op_flags & OPf_STACKED)
+	Perl_pp_rv2av(aTHX);
+    else
+	Perl_pp_padav(aTHX);
+    {
+	dSP;
+	dTOPss;
+	SETs(0); /* special alias marker that aassign recognises */
+	XPUSHs(sv);
+	RETURN;
+    }
+}
 
 /*
  * Local variables: