This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
refactor pp_list
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index cd50626..51335aa 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -493,7 +493,7 @@ PP(pp_prototype)
        const char * s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
            const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
-           if (!code || code == -KEY_CORE)
+           if (!code)
                DIE(aTHX_ "Can't find an opnumber for \"%"UTF8f"\"",
                   UTF8fARG(SvFLAGS(TOPs) & SVf_UTF8, SvCUR(TOPs)-6, s+6));
            {
@@ -571,8 +571,10 @@ S_refto(pTHX_ SV *sv)
        SvTEMP_off(sv);
        SvREFCNT_inc_void_NN(sv);
     }
-    else if (SvPADTMP(sv) && !IS_PADGV(sv))
+    else if (SvPADTMP(sv)) {
+        assert(!IS_PADGV(sv));
         sv = newSVsv(sv);
+    }
     else {
        SvTEMP_off(sv);
        SvREFCNT_inc_void_NN(sv);
@@ -616,9 +618,19 @@ PP(pp_bless)
        const char *ptr;
 
        if (!ssv) goto curstash;
-       if (!SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+       SvGETMAGIC(ssv);
+       if (SvROK(ssv)) {
+         if (!SvAMAGIC(ssv)) {
+          frog:
            Perl_croak(aTHX_ "Attempt to bless into a reference");
-       ptr = SvPV_const(ssv,len);
+         }
+         /* SvAMAGIC is on here, but it only means potentially overloaded,
+            so after stringification: */
+         ptr = SvPV_nomg_const(ssv,len);
+         /* We need to check the flag again: */
+         if (!SvAMAGIC(ssv)) goto frog;
+       }
+       else ptr = SvPV_nomg_const(ssv,len);
        if (len == 0)
            Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
                           "Explicit blessing to '' (assuming package main)");
@@ -1014,10 +1026,13 @@ PP(pp_undef)
                 else stash = NULL;
             }
 
+           SvREFCNT_inc_simple_void_NN(sv_2mortal(sv));
            gp_free(MUTABLE_GV(sv));
            Newxz(gp, 1, GP);
            GvGP_set(sv, gp_ref(gp));
+#ifndef PERL_DONT_CREATE_GVSV
            GvSV(sv) = newSV(0);
+#endif
            GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = MUTABLE_GV(sv);
            GvMULTI_on(sv);
@@ -1694,10 +1709,11 @@ PP(pp_repeat)
                    SvREADONLY_on(*SP);
                }
 #else
-               if (*SP)
-                {
-                   if (mod && SvPADTMP(*SP) && !IS_PADGV(*SP))
+                if (*SP) {
+                   if (mod && SvPADTMP(*SP)) {
+                       assert(!IS_PADGV(*SP));
                        *SP = sv_mortalcopy(*SP);
+                   }
                   SvTEMP_off((*SP));
                }
 #endif
@@ -2712,10 +2728,6 @@ PP(pp_sin)
    --Jarkko Hietaniemi 27 September 1998
  */
 
-#ifndef HAS_DRAND48_PROTO
-extern double drand48 (void);
-#endif
-
 PP(pp_rand)
 {
     dVAR;
@@ -3185,8 +3197,8 @@ PP(pp_index)
     SV *temp = NULL;
     STRLEN biglen;
     STRLEN llen = 0;
-    I32 offset;
-    I32 retval;
+    SSize_t offset = 0;
+    SSize_t retval;
     const char *big_p;
     const char *little_p;
     bool big_utf8;
@@ -3269,13 +3281,13 @@ PP(pp_index)
        offset = is_index ? 0 : biglen;
     else {
        if (big_utf8 && offset > 0)
-           sv_pos_u2b(big, &offset, 0);
+           offset = sv_pos_u2b_flags(big, offset, 0, SV_CONST_RETURN);
        if (!is_index)
            offset += llen;
     }
     if (offset < 0)
        offset = 0;
-    else if (offset > (I32)biglen)
+    else if (offset > (SSize_t)biglen)
        offset = biglen;
     if (!(little_p = is_index
          ? fbm_instr((unsigned char*)big_p + offset,
@@ -3286,7 +3298,7 @@ PP(pp_index)
     else {
        retval = little_p - big_p;
        if (retval > 0 && big_utf8)
-           sv_pos_b2u(big, &retval);
+           retval = sv_pos_b2u_flags(big, retval, SV_CONST_RETURN);
     }
     SvREFCNT_dec(temp);
  fail:
@@ -3316,12 +3328,13 @@ PP(pp_ord)
     if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) {
         SV * const tmpsv = sv_2mortal(newSVsv(argsv));
         s = (U8*)sv_recode_to_utf8(tmpsv, PL_encoding);
+        len = UTF8SKIP(s);  /* Should be well-formed; so this is its length */
         argsv = tmpsv;
     }
 
-    XPUSHu(DO_UTF8(argsv) ?
-          utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV) :
-          (UV)(*s & 0xff));
+    XPUSHu(DO_UTF8(argsv)
+           ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV)
+           : (UV)(*s));
 
     RETURN;
 }
@@ -3470,22 +3483,16 @@ PP(pp_ucfirst)
     STRLEN tculen;  /* tculen is the byte length of the freshly titlecased (or
                     * lowercased) character stored in tmpbuf.  May be either
                     * UTF-8 or not, but in either case is the number of bytes */
-    bool tainted = FALSE;
 
-    SvGETMAGIC(source);
-    if (SvOK(source)) {
-       s = (const U8*)SvPV_nomg_const(source, slen);
-    } else {
-       if (ckWARN(WARN_UNINITIALIZED))
-           report_uninit(source);
-       s = (const U8*)"";
-       slen = 0;
-    }
+    s = (const U8*)SvPV_const(source, slen);
 
     /* We may be able to get away with changing only the first character, in
      * place, but not if read-only, etc.  Later we may discover more reasons to
      * not convert in-place. */
-    inplace = SvPADTMP(source) && !SvREADONLY(source) && SvTEMP(source);
+    inplace = !SvREADONLY(source)
+          && (  SvPADTMP(source)
+             || (  SvTEMP(source) && !SvSMAGICAL(source)
+                && SvREFCNT(source) == 1));
 
     /* First calculate what the changed first character should be.  This affects
      * whether we can just swap it out, leaving the rest of the string unchanged,
@@ -3499,12 +3506,10 @@ PP(pp_ucfirst)
        doing_utf8 = TRUE;
         ulen = UTF8SKIP(s);
         if (op_type == OP_UCFIRST) {
-           _to_utf8_title_flags(s, tmpbuf, &tculen,
-                                cBOOL(IN_LOCALE_RUNTIME), &tainted);
+           _to_utf8_title_flags(s, tmpbuf, &tculen, IN_LOCALE_RUNTIME);
        }
         else {
-           _to_utf8_lower_flags(s, tmpbuf, &tculen,
-                                cBOOL(IN_LOCALE_RUNTIME), &tainted);
+           _to_utf8_lower_flags(s, tmpbuf, &tculen, IN_LOCALE_RUNTIME);
        }
 
         /* we can't do in-place if the length changes.  */
@@ -3527,17 +3532,27 @@ PP(pp_ucfirst)
        }
        /* is ucfirst() */
        else if (IN_LOCALE_RUNTIME) {
-           *tmpbuf = toUPPER_LC(*s);   /* This would be a bug if any locales
-                                        * have upper and title case different
-                                        */
+            if (IN_UTF8_CTYPE_LOCALE) {
+                goto do_uni_rules;
+            }
+
+            *tmpbuf = (U8) toUPPER_LC(*s); /* This would be a bug if any
+                                              locales have upper and title case
+                                              different */
        }
        else if (! IN_UNI_8_BIT) {
            *tmpbuf = toUPPER(*s);      /* Returns caseless for non-ascii, or
                                         * on EBCDIC machines whatever the
                                         * native function does */
        }
-       else { /* is ucfirst non-UTF-8, not in locale, and cased latin1 */
-           UV title_ord = _to_upper_title_latin1(*s, tmpbuf, &tculen, 's');
+        else {
+            /* Here, is ucfirst non-UTF-8, not in locale (unless that locale is
+             * UTF-8, which we treat as not in locale), and cased latin1 */
+           UV title_ord;
+
+      do_uni_rules:
+
+           title_ord = _to_upper_title_latin1(*s, tmpbuf, &tculen, 's');
            if (tculen > 1) {
                assert(tculen == 2);
 
@@ -3638,17 +3653,9 @@ PP(pp_ucfirst)
            SvCUR_set(dest, need - 1);
        }
 
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     }
     else {  /* Neither source nor dest are in or need to be UTF-8 */
        if (slen) {
-           if (IN_LOCALE_RUNTIME) {
-               TAINT;
-               SvTAINTED_on(dest);
-           }
            if (inplace) {  /* in-place, only need to change the 1st char */
                *d = *tmpbuf;
            }
@@ -3676,6 +3683,10 @@ PP(pp_ucfirst)
            SvCUR_set(dest, need - 1);
        }
     }
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (dest != source && SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -3698,17 +3709,25 @@ PP(pp_uc)
 
     SvGETMAGIC(source);
 
-    if (SvPADTMP(source) && !SvREADONLY(source) && !SvAMAGIC(source)
-       && SvTEMP(source) && !DO_UTF8(source)
-       && (IN_LOCALE_RUNTIME || ! IN_UNI_8_BIT)) {
-
-       /* We can convert in place.  The reason we can't if in UNI_8_BIT is to
-        * make the loop tight, so we overwrite the source with the dest before
-        * looking at it, and we need to look at the original source
-        * afterwards.  There would also need to be code added to handle
-        * switching to not in-place in midstream if we run into characters
-        * that change the length.
-        */
+    if ((SvPADTMP(source)
+        ||
+       (SvTEMP(source) && !SvSMAGICAL(source) && SvREFCNT(source) == 1))
+       && !SvREADONLY(source) && SvPOK(source)
+       && !DO_UTF8(source)
+       && ((IN_LOCALE_RUNTIME)
+            ? ! IN_UTF8_CTYPE_LOCALE
+            : ! IN_UNI_8_BIT))
+    {
+
+        /* We can convert in place.  The reason we can't if in UNI_8_BIT is to
+         * make the loop tight, so we overwrite the source with the dest before
+         * looking at it, and we need to look at the original source
+         * afterwards.  There would also need to be code added to handle
+         * switching to not in-place in midstream if we run into characters
+         * that change the length.  Since being in locale overrides UNI_8_BIT,
+         * that latter becomes irrelevant in the above test; instead for
+         * locale, the size can't normally change, except if the locale is a
+         * UTF-8 one */
        dest = source;
        s = d = (U8*)SvPV_force_nomg(source, len);
        min = len + 1;
@@ -3717,21 +3736,7 @@ PP(pp_uc)
 
        dest = TARG;
 
-       /* The old implementation would copy source into TARG at this point.
-          This had the side effect that if source was undef, TARG was now
-          an undefined SV with PADTMP set, and they don't warn inside
-          sv_2pv_flags(). However, we're now getting the PV direct from
-          source, which doesn't have PADTMP set, so it would warn. Hence the
-          little games.  */
-
-       if (SvOK(source)) {
-           s = (const U8*)SvPV_nomg_const(source, len);
-       } else {
-           if (ckWARN(WARN_UNINITIALIZED))
-               report_uninit(source);
-           s = (const U8*)"";
-           len = 0;
-       }
+       s = (const U8*)SvPV_nomg_const(source, len);
        min = len + 1;
 
        SvUPGRADE(dest, SVt_PV);
@@ -3747,7 +3752,6 @@ PP(pp_uc)
     if (DO_UTF8(source)) {
        const U8 *const send = s + len;
        U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-       bool tainted = FALSE;
 
        /* All occurrences of these are to be moved to follow any other marks.
         * This is context-dependent.  We may not be passed enough context to
@@ -3777,8 +3781,7 @@ PP(pp_uc)
              * and copy it to the output buffer */
 
             u = UTF8SKIP(s);
-            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen,
-                                     cBOOL(IN_LOCALE_RUNTIME), &tainted);
+            uv = _to_utf8_upper_flags(s, tmpbuf, &ulen, IN_LOCALE_RUNTIME);
 #define GREEK_CAPITAL_LETTER_IOTA 0x0399
 #define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
             if (uv == GREEK_CAPITAL_LETTER_IOTA
@@ -3813,10 +3816,6 @@ PP(pp_uc)
        *d = '\0';
 
        SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     }
     else {     /* Not UTF-8 */
        if (len) {
@@ -3826,10 +3825,11 @@ PP(pp_uc)
             * latin1 as having case; otherwise the latin1 casing.  Do the
             * whole thing in a tight loop, for speed, */
            if (IN_LOCALE_RUNTIME) {
-               TAINT;
-               SvTAINTED_on(dest);
+                if (IN_UTF8_CTYPE_LOCALE) {
+                    goto do_uni_rules;
+                }
                for (; s < send; d++, s++)
-                   *d = toUPPER_LC(*s);
+                    *d = (U8) toUPPER_LC(*s);
            }
            else if (! IN_UNI_8_BIT) {
                for (; s < send; d++, s++) {
@@ -3837,6 +3837,7 @@ PP(pp_uc)
                }
            }
            else {
+          do_uni_rules:
                for (; s < send; d++, s++) {
                    *d = toUPPER_LATIN1_MOD(*s);
                    if (LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) {
@@ -3925,6 +3926,10 @@ PP(pp_uc)
            SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
        }
     } /* End of isn't utf8 */
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (dest != source && SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -3944,8 +3949,12 @@ PP(pp_lc)
 
     SvGETMAGIC(source);
 
-    if (SvPADTMP(source) && !SvREADONLY(source) && !SvAMAGIC(source)
-       && SvTEMP(source) && !DO_UTF8(source)) {
+    if (   (  SvPADTMP(source)
+          || (  SvTEMP(source) && !SvSMAGICAL(source)
+             && SvREFCNT(source) == 1  )
+          )
+       && !SvREADONLY(source) && SvPOK(source)
+       && !DO_UTF8(source)) {
 
        /* We can convert in place, as lowercasing anything in the latin1 range
         * (or else DO_UTF8 would have been on) doesn't lengthen it */
@@ -3957,21 +3966,7 @@ PP(pp_lc)
 
        dest = TARG;
 
-       /* The old implementation would copy source into TARG at this point.
-          This had the side effect that if source was undef, TARG was now
-          an undefined SV with PADTMP set, and they don't warn inside
-          sv_2pv_flags(). However, we're now getting the PV direct from
-          source, which doesn't have PADTMP set, so it would warn. Hence the
-          little games.  */
-
-       if (SvOK(source)) {
-           s = (const U8*)SvPV_nomg_const(source, len);
-       } else {
-           if (ckWARN(WARN_UNINITIALIZED))
-               report_uninit(source);
-           s = (const U8*)"";
-           len = 0;
-       }
+       s = (const U8*)SvPV_nomg_const(source, len);
        min = len + 1;
 
        SvUPGRADE(dest, SVt_PV);
@@ -3987,17 +3982,15 @@ PP(pp_lc)
     if (DO_UTF8(source)) {
        const U8 *const send = s + len;
        U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
-       bool tainted = FALSE;
 
        while (s < send) {
            const STRLEN u = UTF8SKIP(s);
            STRLEN ulen;
 
-           _to_utf8_lower_flags(s, tmpbuf, &ulen,
-                                cBOOL(IN_LOCALE_RUNTIME), &tainted);
+           _to_utf8_lower_flags(s, tmpbuf, &ulen, IN_LOCALE_RUNTIME);
 
            /* Here is where we would do context-sensitive actions.  See the
-            * commit message for this comment for why there isn't any */
+            * commit message for 86510fb15 for why there isn't any */
 
            if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
 
@@ -4024,10 +4017,6 @@ PP(pp_lc)
        SvUTF8_on(dest);
        *d = '\0';
        SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     } else {   /* Not utf8 */
        if (len) {
            const U8 *const send = s + len;
@@ -4035,12 +4024,10 @@ PP(pp_lc)
            /* Use locale casing if in locale; regular style if not treating
             * latin1 as having case; otherwise the latin1 casing.  Do the
             * whole thing in a tight loop, for speed, */
-           if (IN_LOCALE_RUNTIME) {
-               TAINT;
-               SvTAINTED_on(dest);
+            if (IN_LOCALE_RUNTIME) {
                for (; s < send; d++, s++)
                    *d = toLOWER_LC(*s);
-           }
+            }
            else if (! IN_UNI_8_BIT) {
                for (; s < send; d++, s++) {
                    *d = toLOWER(*s);
@@ -4057,6 +4044,10 @@ PP(pp_lc)
            SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
        }
     }
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (dest != source && SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -4181,12 +4172,11 @@ PP(pp_fc)
 
     send = s + len;
     if (DO_UTF8(source)) { /* UTF-8 flagged string. */
-        bool tainted = FALSE;
         while (s < send) {
             const STRLEN u = UTF8SKIP(s);
             STRLEN ulen;
 
-            _to_utf8_fold_flags(s, tmpbuf, &ulen, flags, &tainted);
+            _to_utf8_fold_flags(s, tmpbuf, &ulen, flags);
 
             if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
                 const UV o = d - (U8*)SvPVX_const(dest);
@@ -4199,23 +4189,21 @@ PP(pp_fc)
             s += u;
         }
         SvUTF8_on(dest);
-       if (tainted) {
-           TAINT;
-           SvTAINTED_on(dest);
-       }
     } /* Unflagged string */
     else if (len) {
         if ( IN_LOCALE_RUNTIME ) { /* Under locale */
-            TAINT;
-            SvTAINTED_on(dest);
+            if (IN_UTF8_CTYPE_LOCALE) {
+                goto do_uni_folding;
+            }
             for (; s < send; d++, s++)
-                *d = toFOLD_LC(*s);
+                *d = (U8) toFOLD_LC(*s);
         }
         else if ( !IN_UNI_8_BIT ) { /* Under nothing, or bytes */
             for (; s < send; d++, s++)
                 *d = toFOLD(*s);
         }
         else {
+      do_uni_folding:
             /* For ASCII and the Latin-1 range, there's only two troublesome
              * folds, \x{DF} (\N{LATIN SMALL LETTER SHARP S}), which under full
              * casefolding becomes 'ss'; and \x{B5} (\N{MICRO SIGN}), which
@@ -4244,7 +4232,7 @@ PP(pp_fc)
                     for (; s < send; s++) {
                         STRLEN ulen;
                         UV fc = _to_uni_fold_flags(*s, tmpbuf, &ulen, flags);
-                        if UNI_IS_INVARIANT(fc) {
+                        if UVCHR_IS_INVARIANT(fc) {
                             if (full_folding
                                 && *s == LATIN_SMALL_LETTER_SHARP_S)
                             {
@@ -4282,6 +4270,10 @@ PP(pp_fc)
     *d = '\0';
     SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
 
+    if (IN_LOCALE_RUNTIME) {
+        TAINT;
+        SvTAINTED_on(dest);
+    }
     if (SvTAINTED(source))
        SvTAINT(dest);
     SvSETMAGIC(dest);
@@ -4354,6 +4346,51 @@ PP(pp_aslice)
     RETURN;
 }
 
+PP(pp_kvaslice)
+{
+    dVAR; dSP; dMARK;
+    AV *const av = MUTABLE_AV(POPs);
+    I32 lval = (PL_op->op_flags & OPf_MOD);
+    SSize_t items = SP - MARK;
+
+    if (PL_op->op_private & OPpMAYBE_LVSUB) {
+       const I32 flags = is_lvalue_sub();
+       if (flags) {
+           if (!(flags & OPpENTERSUB_INARGS))
+               /* diag_listed_as: Can't modify %s in %s */
+              Perl_croak(aTHX_ "Can't modify index/value array slice in list assignment");
+          lval = flags;
+       }
+    }
+
+    MEXTEND(SP,items);
+    while (items > 1) {
+       *(MARK+items*2-1) = *(MARK+items);
+       items--;
+    }
+    items = SP-MARK;
+    SP += items;
+
+    while (++MARK <= SP) {
+        SV **svp;
+
+       svp = av_fetch(av, SvIV(*MARK), lval);
+        if (lval) {
+            if (!svp || !*svp || *svp == &PL_sv_undef) {
+                DIE(aTHX_ PL_no_aelem, SvIV(*MARK));
+            }
+           *MARK = sv_mortalcopy(*MARK);
+        }
+       *++MARK = svp ? *svp : &PL_sv_undef;
+    }
+    if (GIMME != G_ARRAY) {
+       MARK = SP - items*2;
+       *++MARK = items > 0 ? *SP : &PL_sv_undef;
+       SP = MARK;
+    }
+    RETURN;
+}
+
 /* Smart dereferencing for keys, values and each */
 PP(pp_rkeys)
 {
@@ -4402,7 +4439,7 @@ PP(pp_aeach)
     IV *iterp = Perl_av_iter_p(aTHX_ array);
     const IV current = (*iterp)++;
 
-    if (current > av_len(array)) {
+    if (current > av_tindex(array)) {
        *iterp = 0;
        if (gimme == G_SCALAR)
            RETPUSHUNDEF;
@@ -4430,7 +4467,7 @@ PP(pp_akeys)
 
     if (gimme == G_SCALAR) {
        dTARGET;
-       PUSHi(av_len(array) + 1);
+       PUSHi(av_tindex(array) + 1);
     }
     else if (gimme == G_ARRAY) {
         IV n = Perl_av_len(aTHX_ array);
@@ -4757,19 +4794,72 @@ PP(pp_hslice)
     RETURN;
 }
 
+PP(pp_kvhslice)
+{
+    dVAR; dSP; dMARK;
+    HV * const hv = MUTABLE_HV(POPs);
+    I32 lval = (PL_op->op_flags & OPf_MOD);
+    SSize_t items = SP - MARK;
+
+    if (PL_op->op_private & OPpMAYBE_LVSUB) {
+       const I32 flags = is_lvalue_sub();
+       if (flags) {
+           if (!(flags & OPpENTERSUB_INARGS))
+               /* diag_listed_as: Can't modify %s in %s */
+              Perl_croak(aTHX_ "Can't modify key/value hash slice in list assignment");
+          lval = flags;
+       }
+    }
+
+    MEXTEND(SP,items);
+    while (items > 1) {
+       *(MARK+items*2-1) = *(MARK+items);
+       items--;
+    }
+    items = SP-MARK;
+    SP += items;
+
+    while (++MARK <= SP) {
+        SV * const keysv = *MARK;
+        SV **svp;
+        HE *he;
+
+        he = hv_fetch_ent(hv, keysv, lval, 0);
+        svp = he ? &HeVAL(he) : NULL;
+
+        if (lval) {
+            if (!svp || !*svp || *svp == &PL_sv_undef) {
+                DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+            }
+           *MARK = sv_mortalcopy(*MARK);
+        }
+        *++MARK = svp && *svp ? *svp : &PL_sv_undef;
+    }
+    if (GIMME != G_ARRAY) {
+       MARK = SP - items*2;
+       *++MARK = items > 0 ? *SP : &PL_sv_undef;
+       SP = MARK;
+    }
+    RETURN;
+}
+
 /* List operators. */
 
 PP(pp_list)
 {
-    dVAR; dSP; dMARK;
+    dVAR;
+    I32 markidx = POPMARK;
     if (GIMME != G_ARRAY) {
+       SV **mark = PL_stack_base + markidx;
+       dSP;
        if (++MARK <= SP)
            *MARK = *SP;                /* unwanted list, return last item */
        else
            *MARK = &PL_sv_undef;
        SP = MARK;
+       PUTBACK;
     }
-    RETURN;
+    return NORMAL;
 }
 
 PP(pp_lslice)
@@ -4813,8 +4903,10 @@ PP(pp_lslice)
            is_something_there = TRUE;
            if (!(*lelem = firstrelem[ix]))
                *lelem = &PL_sv_undef;
-           else if (mod && SvPADTMP(*lelem) && !IS_PADGV(*lelem))
+           else if (mod && SvPADTMP(*lelem)) {
+                assert(!IS_PADGV(*lelem));
                *lelem = firstrelem[ix] = sv_mortalcopy(*lelem);
+            }
        }
     }
     if (is_something_there)
@@ -4975,14 +5067,18 @@ PP(pp_splice)
 
        MARK = ORIGMARK + 1;
        if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
+           const bool real = cBOOL(AvREAL(ary));
            MEXTEND(MARK, length);
-           Copy(AvARRAY(ary)+offset, MARK, length, SV*);
-           if (AvREAL(ary)) {
+           if (real)
                EXTEND_MORTAL(length);
-               for (i = length, dst = MARK; i; i--) {
+           for (i = 0, dst = MARK; i < length; i++) {
+               if ((*dst = AvARRAY(ary)[i+offset])) {
+                 if (real)
                    sv_2mortal(*dst);   /* free them eventually */
-                   dst++;
                }
+               else
+                   *dst = &PL_sv_undef;
+               dst++;
            }
            MARK += length - 1;
        }
@@ -5068,13 +5164,16 @@ PP(pp_splice)
        MARK = ORIGMARK + 1;
        if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
            if (length) {
-               Copy(tmparyval, MARK, length, SV*);
-               if (AvREAL(ary)) {
+               const bool real = cBOOL(AvREAL(ary));
+               if (real)
                    EXTEND_MORTAL(length);
-                   for (i = length, dst = MARK; i; i--) {
+               for (i = 0, dst = MARK; i < length; i++) {
+                   if ((*dst = tmparyval[i])) {
+                     if (real)
                        sv_2mortal(*dst);       /* free them eventually */
-                       dst++;
                    }
+                   else *dst = &PL_sv_undef;
+                   dst++;
                }
            }
            MARK += length - 1;
@@ -5206,7 +5305,7 @@ PP(pp_reverse)
                const MAGIC *mg;
                bool can_preserve = SvCANEXISTDELETE(av);
 
-               for (i = 0, j = av_len(av); i < j; ++i, --j) {
+               for (i = 0, j = av_tindex(av); i < j; ++i, --j) {
                    SV *begin, *end;
 
                    if (can_preserve) {
@@ -5555,7 +5654,7 @@ PP(pp_split)
     else if (do_utf8 == (RX_UTF8(rx) != 0) &&
             (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
             && (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-            && !(RX_EXTFLAGS(rx) & RXf_ANCH)) {
+             && !(RX_EXTFLAGS(rx) & RXf_IS_ANCHORED)) {
        const int tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL);
        SV * const csv = CALLREG_INTUIT_STRING(rx);
 
@@ -5885,7 +5984,7 @@ PP(pp_coreargs)
                const bool constr = PL_op->op_private & whicharg;
                PUSHs(S_rv2gv(aTHX_
                    svp && *svp ? *svp : &PL_sv_undef,
-                   constr, CopHINTS_get(PL_curcop) & HINT_STRICT_REFS,
+                   constr, cBOOL(CopHINTS_get(PL_curcop) & HINT_STRICT_REFS),
                    !constr
                ));
            }
@@ -5907,7 +6006,6 @@ PP(pp_coreargs)
                )
               )
                DIE(aTHX_
-               /* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/
                 "Type of arg %d to &CORE::%s must be %s",
                  whicharg, PL_op_name[opnum],
                  wantscalar