diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2012-10-08 00:20:21 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2012-11-27 07:05:01 -0800 |
| commit | db2c6cb33ec067c880a2cb3c4efdb33f7e3e3d0f (patch) | |
| tree | 2460f0a21a4cfde265cd5fd481296eee2515c150 /pp_hot.c | |
| parent | 08bf00be470db7b367e14733226d4fddc004c796 (diff) | |
| download | perl-db2c6cb33ec067c880a2cb3c4efdb33f7e3e3d0f.tar.gz | |
New COW mechanism
This was discussed in ticket #114820.
This new copy-on-write mechanism stores a reference count for the
PV inside the PV itself, at the very end. (I was using SvEND+1
at first, but parts of the regexp engine expect to be able to do
SvCUR_set(sv,0), which causes the wrong byte of the string to be used
as the reference count.) Only 256 SVs can share the same PV this way.
Also, only strings with allocated space after the trailing null can
be used for copy-on-write.
Much of the code is shared with PERL_OLD_COPY_ON_WRITE. The restric-
tion against doing copy-on-write with magical variables has hence been
inherited, though it is not necessary. A future commit will take
care of that.
I had to modify _core_swash_init to handle $@ differently. The exist-
ing mechanism of copying $@ to a new scalar and back again was very
fragile. With copy-on-write, $@ =~ s/// can cause pp_subst’s string
pointers to become stale. So now we remove the scalar from *@ and
allow the utf8-table-loading code to autovivify a new one. Then we
restore the untouched $@ afterwards if all goes well.
Diffstat (limited to 'pp_hot.c')
| -rw-r--r-- | pp_hot.c | 20 |
1 files changed, 10 insertions, 10 deletions
@@ -1571,8 +1571,8 @@ yup: /* Confirmed by INTUIT */ } if (PL_sawampersand || RX_EXTFLAGS(rx) & RXf_PMf_KEEPCOPY) { I32 off; -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) { +#ifdef PERL_ANY_COW + if (SvCANCOW(TARG)) { if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n", @@ -1588,7 +1588,7 @@ yup: /* Confirmed by INTUIT */ { RX_SUBBEG(rx) = savepvn(t, strend - t); -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW RX_SAVED_COPY(rx) = NULL; #endif } @@ -2148,7 +2148,7 @@ PP(pp_subst) const I32 oldsave = PL_savestack_ix; STRLEN slen; bool doutf8 = FALSE; /* whether replacement is in utf8 */ -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW bool is_cow; #endif SV *nsv = NULL; @@ -2167,7 +2167,7 @@ PP(pp_subst) } SvGETMAGIC(TARG); /* must come before cow check */ -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW /* Awooga. Awooga. "bool" types that are actually char are dangerous, because they make integers such as 256 "false". */ is_cow = SvIsCOW(TARG) ? TRUE : FALSE; @@ -2176,7 +2176,7 @@ PP(pp_subst) sv_force_normal_flags(TARG,0); #endif if (!(rpm->op_pmflags & PMf_NONDESTRUCT) -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW && !is_cow #endif && (SvREADONLY(TARG) @@ -2284,7 +2284,7 @@ PP(pp_subst) /* can do inplace substitution? */ if (c -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW && !is_cow #endif && (I32)clen <= RX_MINLENRET(rx) @@ -2294,7 +2294,7 @@ PP(pp_subst) && !(rpm->op_pmflags & PMf_NONDESTRUCT)) { -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW if (SvIsCOW(TARG)) { assert (!force_on_match); goto have_a_cow; @@ -2390,7 +2390,7 @@ PP(pp_subst) s = SvPV_force_nomg(TARG, len); goto force_it; } -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW have_a_cow: #endif if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ @@ -2456,7 +2456,7 @@ PP(pp_subst) SPAGAIN; PUSHs(dstr); } else { -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW /* 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 |