S_del_body is sufficiently small that inlining it is a space win.
[p5sagit/p5-mst-13.2.git] / pp_hot.c
index 5115e03..bd61e40 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -153,7 +153,7 @@ PP(pp_concat)
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
-       rpv = SvPV(right, rlen);        /* no point setting UTF-8 here */
+       rpv = SvPV_const(right, rlen);  /* no point setting UTF-8 here */
        rcopied = TRUE;
     }
 
@@ -173,7 +173,7 @@ PP(pp_concat)
            mg_get(left);               /* or mg_get(left) may happen here */
        if (!SvOK(TARG))
            sv_setpvn(left, "", 0);
-       (void)SvPV_nomg(left, llen);    /* Needed to set UTF8 flag */
+       (void)SvPV_nomg_const(left, llen);    /* Needed to set UTF8 flag */
        lbyte = !DO_UTF8(left);
        if (IN_BYTES)
            SvUTF8_off(TARG);
@@ -186,7 +186,7 @@ PP(pp_concat)
            if (!rcopied)
                right = sv_2mortal(newSVpvn(rpv, rlen));
            sv_utf8_upgrade_nomg(right);
-           rpv = SvPV(right, rlen);
+           rpv = SvPV_const(right, rlen);
        }
     }
     sv_catpvn_nomg(TARG, rpv, rlen);
@@ -971,7 +971,6 @@ PP(pp_aassign)
     if (PL_op->op_private & (OPpASSIGN_COMMON)) {
        EXTEND_MORTAL(lastrelem - firstrelem + 1);
        for (relem = firstrelem; relem <= lastrelem; relem++) {
-           /*SUPPRESS 560*/
            if ((sv = *relem)) {
                TAINT_NOT;      /* Each item is independent */
                *relem = sv_mortalcopy(sv);
@@ -1301,7 +1300,6 @@ play_it_again:
        EXTEND_MORTAL(nparens + i);
        for (i = !i; i <= nparens; i++) {
            PUSHs(sv_newmortal());
-           /*SUPPRESS 560*/
            if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
                const I32 len = rx->endp[i] - rx->startp[i];
                s = rx->startp[i] + truebase;
@@ -1389,7 +1387,7 @@ yup:                                      /* Confirmed by INTUIT */
     }
     if (PL_sawampersand) {
        I32 off;
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
            if (DEBUG_C_TEST) {
                PerlIO_printf(Perl_debug_log,
@@ -1398,14 +1396,14 @@ yup:                                    /* Confirmed by INTUIT */
                              (int)(t-truebase));
            }
            rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
-           rx->subbeg = SvPVX_const(rx->saved_copy) + (t - truebase);
+           rx->subbeg = (char *) SvPVX_const(rx->saved_copy) + (t - truebase);
            assert (SvPOKp(rx->saved_copy));
        } else
 #endif
        {
 
            rx->subbeg = savepvn(t, strend - t);
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
            rx->saved_copy = Nullsv;
 #endif
        }
@@ -1527,8 +1525,7 @@ Perl_do_readline(pTHX)
        offset = 0;
        if (type == OP_RCATLINE && SvOK(sv)) {
            if (!SvPOK(sv)) {
-               STRLEN n_a;
-               (void)SvPV_force(sv, n_a);
+               SvPV_force_nolen(sv);
            }
            offset = SvCUR(sv);
        }
@@ -1591,6 +1588,7 @@ Perl_do_readline(pTHX)
        XPUSHs(sv);
        if (type == OP_GLOB) {
            char *tmps;
+           const char *t1;
 
            if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
                tmps = SvEND(sv) - 1;
@@ -1599,16 +1597,16 @@ Perl_do_readline(pTHX)
                    SvCUR_set(sv, SvCUR(sv) - 1);
                }
            }
-           for (tmps = SvPVX(sv); *tmps; tmps++)
-               if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
-                   strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
+           for (t1 = SvPVX_const(sv); *t1; t1++)
+               if (!isALPHA(*t1) && !isDIGIT(*t1) &&
+                   strchr("$&*(){}[]'\";\\|?<>~`", *t1))
                        break;
-           if (*tmps && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
+           if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
                (void)POPs;             /* Unmatched wildcard?  Chuck it... */
                continue;
            }
        } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
-            const U8 *s = (U8*)SvPVX(sv) + offset;
+            const U8 *s = (const U8*)SvPVX_const(sv) + offset;
             const STRLEN len = SvCUR(sv) - offset;
             const U8 *f;
             
@@ -1819,7 +1817,7 @@ PP(pp_iter)
            /* string increment */
            register SV* cur = cx->blk_loop.iterlval;
            STRLEN maxlen = 0;
-           const char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
+           const char *max = SvOK((SV*)av) ? SvPV_const((SV*)av, maxlen) : "";
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
                if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
                    /* safe to reuse old SV */
@@ -1958,7 +1956,7 @@ PP(pp_subst)
     I32 oldsave = PL_savestack_ix;
     STRLEN slen;
     bool doutf8 = FALSE;
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
     bool is_cow;
 #endif
     SV *nsv = Nullsv;
@@ -1974,7 +1972,7 @@ PP(pp_subst)
        EXTEND(SP,1);
     }
 
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
     /* Awooga. Awooga. "bool" types that are actually char are dangerous,
        because they make integers such as 256 "false".  */
     is_cow = SvIsCOW(TARG) ? TRUE : FALSE;
@@ -1983,7 +1981,7 @@ PP(pp_subst)
        sv_force_normal_flags(TARG,0);
 #endif
     if (
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        !is_cow &&
 #endif
        (SvREADONLY(TARG)
@@ -1992,7 +1990,7 @@ PP(pp_subst)
        DIE(aTHX_ PL_no_modify);
     PUTBACK;
 
-    s = SvPV(TARG, len);
+    s = SvPV_mutable(TARG, len);
     if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
        force_on_match = 1;
     rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
@@ -2067,7 +2065,7 @@ PP(pp_subst)
     
     /* can do inplace substitution? */
     if (c
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        && !is_cow
 #endif
        && (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
@@ -2081,7 +2079,7 @@ PP(pp_subst)
            LEAVE_SCOPE(oldsave);
            RETURN;
        }
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        if (SvIsCOW(TARG)) {
            assert (!force_on_match);
            goto have_a_cow;
@@ -2113,7 +2111,6 @@ PP(pp_subst)
                *m = '\0';
                SvCUR_set(TARG, m - s);
            }
-           /*SUPPRESS 560*/
            else if ((i = m - s)) {     /* faster from front */
                d -= clen;
                m = d;
@@ -2142,7 +2139,6 @@ PP(pp_subst)
                    DIE(aTHX_ "Substitution loop");
                rxtainted |= RX_MATCH_TAINTED(rx);
                m = rx->startp[0] + orig;
-               /*SUPPRESS 560*/
                if ((i = m - s)) {
                    if (s != d)
                        Move(s, d, i, char);
@@ -2188,7 +2184,7 @@ PP(pp_subst)
            s = SvPV_force(TARG, len);
            goto force_it;
        }
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
       have_a_cow:
 #endif
        rxtainted |= RX_MATCH_TAINTED(rx);
@@ -2232,7 +2228,7 @@ PP(pp_subst)
        else
            sv_catpvn(dstr, s, strend - s);
 
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
        /* The match may make the string COW. If so, brilliant, because that's
           just saved us one malloc, copy and free - the regexp has donated
           the old buffer, and we malloc an entirely new one, rather than the
@@ -2619,8 +2615,7 @@ PP(pp_entersub)
                sym = SvPOKp(sv) ? SvPVX_const(sv) : Nullch;
            }
            else {
-                STRLEN n_a;
-               sym = SvPV(sv, n_a);
+               sym = SvPV_nolen_const(sv);
             }
            if (!sym)
                DIE(aTHX_ PL_no_usym, "a subroutine");