Fix the compile for -DPERL_OLD_COPY_ON_WRITE (apart from the tenacious

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index e686b2a..5bc38be 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -43,7 +43,7 @@ PP(pp_const)
         /* This is a const op added to hold the hints hash for
            pp_entereval. The hash can be modified by the code
            being eval'ed, so we return a copy instead. */
-        XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)));
+        mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
     else
         /* Normal const. */
         XPUSHs(cSVOP_sv);
@@ -248,7 +248,7 @@ PP(pp_concat)
        /* mg_get(right) may happen here ... */
        rpv = SvPV_const(right, rlen);
        rbyte = !DO_UTF8(right);
-       right = sv_2mortal(newSVpvn(rpv, rlen));
+       right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
        rpv = SvPV_const(right, rlen);  /* no point setting UTF-8 here */
        rcopied = TRUE;
     }
@@ -287,7 +287,7 @@ PP(pp_concat)
            sv_utf8_upgrade_nomg(TARG);
        else {
            if (!rcopied)
-               right = sv_2mortal(newSVpvn(rpv, rlen));
+               right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
            sv_utf8_upgrade_nomg(right);
            rpv = SvPV_const(right, rlen);
        }
@@ -1194,11 +1194,21 @@ PP(pp_qr)
     REGEXP * rx = PM_GETRE(pm);
     SV * const pkg = CALLREG_PACKAGE(rx);
     SV * const rv = sv_newmortal();
-    SV * const sv = newSVrv(rv, pkg ? SvPV_nolen(pkg) : NULL);
+
+    SvUPGRADE(rv, SVt_IV);
+    /* This RV is about to own a reference to the regexp. (In addition to the
+       reference already owned by the PMOP.  */
+    ReREFCNT_inc(rx);
+    SvRV_set(rv, rx);
+    SvROK_on(rv);
+
+    if (pkg) {
+       HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+       (void)sv_bless(rv, stash);
+    }
+
     if (RX_EXTFLAGS(rx) & RXf_TAINTED)
         SvTAINTED_on(rv);
-    sv_upgrade(sv, SVt_REGEXP);
-    ((struct xregexp *)SvANY(sv))->xrx_regexp = ReREFCNT_inc(rx);
     XPUSHs(rv);
     RETURN;
 }
@@ -1469,16 +1479,17 @@ yup:                                    /* Confirmed by INTUIT */
                              (int) SvTYPE(TARG), (void*)truebase, (void*)t,
                              (int)(t-truebase));
            }
-           rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
-           RX_SUBBEG(rx) = (char *) SvPVX_const(rx->saved_copy) + (t - truebase);
-           assert (SvPOKp(rx->saved_copy));
+           RX_SAVED_COPY(rx) = sv_setsv_cow(RX_SAVED_COPY(rx), TARG);
+           RX_SUBBEG(rx)
+               = (char *) SvPVX_const(RX_SAVED_COPY(rx)) + (t - truebase);
+           assert (SvPOKp(RX_SAVED_COPY(rx)));
        } else
 #endif
        {
 
            RX_SUBBEG(rx) = savepvn(t, strend - t);
 #ifdef PERL_OLD_COPY_ON_WRITE
-           rx->saved_copy = NULL;
+           RX_SAVED_COPY(rx) = NULL;
 #endif
        }
        RX_SUBLEN(rx) = strend - t;
@@ -2241,7 +2252,7 @@ PP(pp_subst)
            }
            TAINT_IF(rxtainted & 1);
            SPAGAIN;
-           PUSHs(sv_2mortal(newSViv((I32)iters)));
+           mPUSHi((I32)iters);
        }
        (void)SvPOK_only_UTF8(TARG);
        TAINT_IF(rxtainted);
@@ -2268,10 +2279,8 @@ PP(pp_subst)
       have_a_cow:
 #endif
        rxtainted |= RX_MATCH_TAINTED(rx);
-       dstr = newSVpvn(m, s-m);
+       dstr = newSVpvn_utf8(m, s-m, DO_UTF8(TARG));
        SAVEFREESV(dstr);
-       if (DO_UTF8(TARG))
-           SvUTF8_on(dstr);
        PL_curpm = pm;
        if (!c) {
            register PERL_CONTEXT *cx;
@@ -2329,7 +2338,7 @@ PP(pp_subst)
 
        TAINT_IF(rxtainted & 1);
        SPAGAIN;
-       PUSHs(sv_2mortal(newSViv((I32)iters)));
+       mPUSHi((I32)iters);
 
        (void)SvPOK_only(TARG);
        if (doutf8)