mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

s/PERL_COPY_ON_WRITE/PERL_OLD_COPY_ON_WRITE/g

Browse Source 
p4raw-id: //depot/perl@24755
This commit is contained in:
Nicholas Clark 2005-06-08 10:08:01 +00:00
parent 1a4fad3712
commit f8c7b90fa8
16 changed files with 61 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
dump.c
View File

@ -1281,7 +1281,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV)
|| type == SVt_IV) {
if (SvIsUV(sv)
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
|| SvIsCOW(sv)
#endif
)
@ -1290,7 +1290,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
if (SvOOK(sv))
PerlIO_printf(file, " (OFFSET)");
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW_shared_hash(sv))
PerlIO_printf(file, " (HASH)");
else if (SvIsCOW_normal(sv))

6
embed.fnc
View File

@ -965,7 +965,7 @@ Ap |void |sys_intern_init
Ap |char * |custom_op_name |NN const OP* op
Ap |char * |custom_op_desc |NN const OP* op
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
pMX |int |sv_release_IVX |SV *sv
#endif
@ -1269,7 +1269,7 @@ s |bool |utf8_mg_pos |NN SV *sv|NN MAGIC **mgp|NN STRLEN **cachep \
s |bool |utf8_mg_pos_init |NN SV *sv|NN MAGIC **mgp \
|NN STRLEN **cachep|I32 i|I32 offsetp \
|NN const U8 *s|NN const U8 *start
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
sM |void |sv_release_COW |SV *sv|const char *pvx|STRLEN cur|STRLEN len \
|U32 hash|SV *after
#endif
@ -1361,7 +1361,7 @@ Apd |char* |sv_pvn_force_flags|SV* sv|NN STRLEN* lp|I32 flags
Apd |void |sv_copypv |NN SV* dsv|NN SV* ssv
Ap |char* |my_atof2 |NN const char *s|NN NV* value
Apn |int |my_socketpair |int family|int type|int protocol|int fd[2]
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
pMXE |SV* |sv_setsv_cow |SV* dsv|SV* ssv
#endif

12
embed.h
View File

@ -1002,7 +1002,7 @@
#endif
#define custom_op_name Perl_custom_op_name
#define custom_op_desc Perl_custom_op_desc
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
#ifdef PERL_CORE
#define sv_release_IVX Perl_sv_release_IVX
#endif
@ -1331,7 +1331,7 @@
#define utf8_mg_pos S_utf8_mg_pos
#define utf8_mg_pos_init S_utf8_mg_pos_init
#endif
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
#ifdef PERL_CORE
#define sv_release_COW S_sv_release_COW
#endif
@ -1431,7 +1431,7 @@
#define sv_copypv Perl_sv_copypv
#define my_atof2 Perl_my_atof2
#define my_socketpair Perl_my_socketpair
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
#if defined(PERL_CORE) || defined(PERL_EXT)
#define sv_setsv_cow Perl_sv_setsv_cow
#endif
@ -2991,7 +2991,7 @@
#endif
#define custom_op_name(a) Perl_custom_op_name(aTHX_ a)
#define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a)
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
#ifdef PERL_CORE
#define sv_release_IVX(a) Perl_sv_release_IVX(aTHX_ a)
#endif
@ -3319,7 +3319,7 @@
#define utf8_mg_pos(a,b,c,d,e,f,g,h,i) S_utf8_mg_pos(aTHX_ a,b,c,d,e,f,g,h,i)
#define utf8_mg_pos_init(a,b,c,d,e,f,g) S_utf8_mg_pos_init(aTHX_ a,b,c,d,e,f,g)
#endif
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
#ifdef PERL_CORE
#define sv_release_COW(a,b,c,d,e,f) S_sv_release_COW(aTHX_ a,b,c,d,e,f)
#endif
@ -3419,7 +3419,7 @@
#define sv_copypv(a,b) Perl_sv_copypv(aTHX_ a,b)
#define my_atof2(a,b) Perl_my_atof2(aTHX_ a,b)
#define my_socketpair Perl_my_socketpair
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
#if defined(PERL_CORE) || defined(PERL_EXT)
#define sv_setsv_cow(a,b) Perl_sv_setsv_cow(aTHX_ a,b)
#endif

2
ext/B/t/bytecode.t
View File

@ -19,7 +19,7 @@ BEGIN {
print "1..0 # Skip -- Perl configured without B module\n";
exit 0;
}
if ($Config{ccflags} =~ /-DPERL_COPY_ON_WRITE/) {
if ($Config{ccflags} =~ /-DPERL_OLD_COPY_ON_WRITE/) {
print "1..0 # skip - no COW for now\n";
exit 0;
}

6
ext/Devel/PPPort/parts/embed.fnc
View File

@ -956,7 +956,7 @@ Ap |void |sys_intern_init
Ap |char * |custom_op_name |OP* op
Ap |char * |custom_op_desc |OP* op
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
pMX |int |sv_release_IVX |SV *sv
#endif
@ -1224,7 +1224,7 @@ s |SV* |gv_share |SV *sv|CLONE_PARAMS *param
# endif
s |bool |utf8_mg_pos |SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|I32 uoff|U8 **sp|U8 *start|U8 *send
s |bool |utf8_mg_pos_init |SV *sv|MAGIC **mgp|STRLEN **cachep|I32 i|I32 *offsetp|U8 *s|U8 *start
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
sM |void |sv_release_COW |SV *sv|char *pvx|STRLEN cur|STRLEN len \
|U32 hash|SV *after
#endif
@ -1311,7 +1311,7 @@ Apd |char* |sv_2pv_flags |SV* sv|STRLEN* lp|I32 flags
Apd |void |sv_copypv |SV* dsv|SV* ssv
Ap |char* |my_atof2 |const char *s|NV* value
Apn |int |my_socketpair |int family|int type|int protocol|int fd[2]
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
pMXE |SV* |sv_setsv_cow |SV* dsv|SV* ssv
#endif

2
makedef.pl
View File

@ -599,7 +599,7 @@ else {
)];
}
unless ($define{'PERL_COPY_ON_WRITE'}) {
unless ($define{'PERL_OLD_COPY_ON_WRITE'}) {
skip_symbols [qw(
Perl_sv_setsv_cow
Perl_sv_release_IVX

4
mg.c
View File

@ -81,7 +81,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
{
MGS* mgs;
assert(SvMAGICAL(sv));
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
/* Turning READONLY off for a copy-on-write scalar is a bad idea. */
if (SvIsCOW(sv))
sv_force_normal(sv);
@ -2643,7 +2643,7 @@ restore_magic(pTHX_ const void *p)
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
{
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
/* While magic was saved (and off) sv_setsv may well have seen
this SV as a prime candidate for COW. */
if (SvIsCOW(sv))

2
pad.c
View File

@ -1235,7 +1235,7 @@ Perl_pad_free(pTHX_ PADOFFSET po)
#ifdef USE_ITHREADS
/* SV could be a shared hash key (eg bugid #19022) */
if (
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
!SvIsCOW(PL_curpad[po])
#else
!SvFAKE(PL_curpad[po])

10
pp_ctl.c
View File

@ -233,7 +233,7 @@ PP(pp_substcont)
}
cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(targ)) {
sv_force_normal_flags(targ, SV_COW_DROP_PV);
} else
@ -308,7 +308,7 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
U32 i;
if (!p || p[1] < rx->nparens) {
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
i = 7 + rx->nparens * 2;
#else
i = 6 + rx->nparens * 2;
@ -323,7 +323,7 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
*p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
RX_MATCH_COPIED_off(rx);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
*p++ = PTR2UV(rx->saved_copy);
rx->saved_copy = Nullsv;
#endif
@ -348,7 +348,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
RX_MATCH_COPIED_set(rx, *p);
*p++ = 0;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (rx->saved_copy)
SvREFCNT_dec (rx->saved_copy);
rx->saved_copy = INT2PTR(SV*,*p);
@ -372,7 +372,7 @@ Perl_rxres_free(pTHX_ void **rsp)
if (p) {
Safefree(INT2PTR(char*,*p));
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (p[1]) {
SvREFCNT_dec (INT2PTR(SV*,p[1]));
}

18
pp_hot.c
View File

@ -1389,7 +1389,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,
@ -1405,7 +1405,7 @@ yup: /* Confirmed by INTUIT */
{
rx->subbeg = savepvn(t, strend - t);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
rx->saved_copy = Nullsv;
#endif
}
@ -1958,7 +1958,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 +1974,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 +1983,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)
@ -2067,7 +2067,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 +2081,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;
@ -2188,7 +2188,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 +2232,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

6
proto.h
View File

@ -1809,7 +1809,7 @@ PERL_CALLCONV char * Perl_custom_op_desc(pTHX_ const OP* op)
__attribute__nonnull__(pTHX_1);
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
PERL_CALLCONV int Perl_sv_release_IVX(pTHX_ SV *sv);
#endif
@ -2398,7 +2398,7 @@ STATIC bool S_utf8_mg_pos_init(pTHX_ SV *sv, MAGIC **mgp, STRLEN **cachep, I32 i
__attribute__nonnull__(pTHX_6)
__attribute__nonnull__(pTHX_7);
#if defined(PERL_COPY_ON_WRITE)
#if defined(PERL_OLD_COPY_ON_WRITE)
STATIC void S_sv_release_COW(pTHX_ SV *sv, const char *pvx, STRLEN cur, STRLEN len, U32 hash, SV *after);
#endif
#endif
@ -2520,7 +2520,7 @@ PERL_CALLCONV char* Perl_my_atof2(pTHX_ const char *s, NV* value)
__attribute__nonnull__(pTHX_2);
PERL_CALLCONV int Perl_my_socketpair(int family, int type, int protocol, int fd[2]);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
PERL_CALLCONV SV* Perl_sv_setsv_cow(pTHX_ SV* dsv, SV* ssv);
#endif

6
regcomp.c
View File

@ -2900,7 +2900,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
r->prelen = xend - exp;
r->precomp = savepvn(RExC_precomp, r->prelen);
r->subbeg = NULL;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
r->saved_copy = Nullsv;
#endif
r->reganch = pm->op_pmflags & PMf_COMPILETIME;
@ -6156,7 +6156,7 @@ Perl_pregfree(pTHX_ struct regexp *r)
if (r->offsets) /* 20010421 MJD */
Safefree(r->offsets);
RX_MATCH_COPY_FREE(r);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (r->saved_copy)
SvREFCNT_dec(r->saved_copy);
#endif
@ -6338,7 +6338,7 @@ Perl_save_re_context(pTHX)
PL_reg_oldsaved = Nullch;
SAVEI32(PL_reg_oldsavedlen); /* old length of saved substr during match */
PL_reg_oldsavedlen = 0;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
SAVESPTR(PL_nrs);
PL_nrs = Nullsv;
#endif

6
regexec.c
View File

@ -2061,7 +2061,7 @@ got_it:
RX_MATCH_COPY_FREE(prog);
if (flags & REXEC_COPY_STR) {
I32 i = PL_regeol - startpos + (stringarg - strbeg);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if ((SvIsCOW(sv)
|| (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
if (DEBUG_C_TEST) {
@ -2169,7 +2169,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
$` inside (?{}) could fail... */
PL_reg_oldsaved = prog->subbeg;
PL_reg_oldsavedlen = prog->sublen;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
PL_nrs = prog->saved_copy;
#endif
RX_MATCH_COPIED_off(prog);
@ -4908,7 +4908,7 @@ restore_pos(pTHX_ void *arg)
if (PL_reg_oldsaved) {
PL_reg_re->subbeg = PL_reg_oldsaved;
PL_reg_re->sublen = PL_reg_oldsavedlen;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
PL_reg_re->saved_copy = PL_nrs;
#endif
RX_MATCH_COPIED_on(PL_reg_re);

4
regexp.h
View File

@ -37,7 +37,7 @@ typedef struct regexp {
struct reg_data *data; /* Additional data. */
char *subbeg; /* saved or original string
so \digit works forever. */
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
SV *saved_copy; /* If non-NULL, SV which is COW from original */
#endif
U32 *offsets; /* offset annotations 20001228 MJD */
@ -104,7 +104,7 @@ typedef struct regexp {
? RX_MATCH_COPIED_on(prog) \
: RX_MATCH_COPIED_off(prog))
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
#define RX_MATCH_COPY_FREE(rx) \
STMT_START {if (rx->saved_copy) { \
SV_CHECK_THINKFIRST_COW_DROP(rx->saved_copy); \

30
sv.c
View File

@ -47,7 +47,7 @@
#define ASSERT_UTF8_CACHE(cache) NOOP
#endif
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
#define SV_COW_NEXT_SV(sv) INT2PTR(SV *,SvUVX(sv))
#define SV_COW_NEXT_SV_SET(current,next) SvUV_set(current, PTR2UV(next))
/* This is a pessimistic view. Scalar must be purely a read-write PV to copy-
@ -4193,7 +4193,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
}
break;
case SVt_PVFM:
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
if (dtype < SVt_PVIV)
sv_upgrade(dstr, SVt_PVIV);
@ -4464,7 +4464,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
if (
/* We're not already COW */
((sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
#ifndef PERL_COPY_ON_WRITE
#ifndef PERL_OLD_COPY_ON_WRITE
/* or we are, but dstr isn't a suitable target. */
|| (SvFLAGS(dstr) & CAN_COW_MASK) != CAN_COW_FLAGS
#endif
@ -4479,7 +4479,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
SvLEN(sstr) && /* and really is a string */
/* and won't be needed again, potentially */
!(PL_op && PL_op->op_type == OP_AASSIGN))
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
&& !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
&& (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
&& SvTYPE(sstr) >= SVt_PVIV)
@ -4493,7 +4493,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
SvCUR_set(dstr, len);
*SvEND(dstr) = '\0';
} else {
/* If PERL_COPY_ON_WRITE is not defined, then isSwipe will always
/* If PERL_OLD_COPY_ON_WRITE is not defined, then isSwipe will always
be true in here. */
/* Either it's a shared hash key, or it's suitable for
copy-on-write or we can swipe the string. */
@ -4502,7 +4502,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
sv_dump(sstr);
sv_dump(dstr);
}
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (!isSwipe) {
/* I believe I should acquire a global SV mutex if
it's a COW sv (not a shared hash key) to stop
@ -4534,7 +4534,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
/* making another shared SV. */
STRLEN cur = SvCUR(sstr);
STRLEN len = SvLEN(sstr);
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (len) {
assert (SvTYPE(dstr) >= SVt_PVIV);
/* SvIsCOW_normal */
@ -4655,7 +4655,7 @@ Perl_sv_setsv_mg(pTHX_ SV *dstr, register SV *sstr)
SvSETMAGIC(dstr);
}
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
SV *
Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
{
@ -4874,7 +4874,7 @@ Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len
SvSETMAGIC(sv);
}
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
/* Need to do this *after* making the SV normal, as we need the buffer
pointer to remain valid until after we've copied it. If we let go too early,
another thread could invalidate it by unsharing last of the same hash key
@ -4941,7 +4941,7 @@ with flags set to 0.
void
Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
{
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvREADONLY(sv)) {
/* At this point I believe I should acquire a global SV mutex. */
if (SvFAKE(sv)) {
@ -5381,7 +5381,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
const MGVTBL *vtable = 0;
MAGIC* mg;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
#endif
@ -5809,7 +5809,7 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
}
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
if (SvIsCOW_normal(nsv)) {
/* We need to follow the pointers around the loop to make the
previous SV point to sv, rather than nsv. */
@ -5979,7 +5979,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
else
SvREFCNT_dec(SvRV(sv));
}
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
else if (SvPVX_const(sv)) {
if (SvIsCOW(sv)) {
/* I believe I need to grab the global SV mutex here and
@ -10321,7 +10321,7 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
ret->subbeg = SAVEPVN(r->subbeg, r->sublen);
else
ret->subbeg = Nullch;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
ret->saved_copy = Nullsv;
#endif
@ -12389,7 +12389,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_reg_curpm = (PMOP*)NULL;
PL_reg_oldsaved = Nullch;
PL_reg_oldsavedlen = 0;
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
PL_nrs = Nullsv;
#endif
PL_reg_maxiter = 0;

4
sv.h
View File

@ -1359,13 +1359,13 @@ Like C<sv_catsv> but doesn't process magic.
#define SV_CHECK_THINKFIRST_COW_DROP(sv) if (SvTHINKFIRST(sv)) \
sv_force_normal_flags(sv, SV_COW_DROP_PV)
#ifdef PERL_COPY_ON_WRITE
#ifdef PERL_OLD_COPY_ON_WRITE
# define SvRELEASE_IVX(sv) ((void)((SvFLAGS(sv) & (SVf_OOK|SVf_READONLY|SVf_FAKE)) \
&& Perl_sv_release_IVX(aTHX_ sv)))
# define SvIsCOW_normal(sv) (SvIsCOW(sv) && SvLEN(sv))
#else
# define SvRELEASE_IVX(sv) SvOOK_off(sv)
#endif /* PERL_COPY_ON_WRITE */
#endif /* PERL_OLD_COPY_ON_WRITE */
#define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \