diff options
| -rw-r--r-- | dump.c | 9 | ||||
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | embed.h | 3 | ||||
| -rw-r--r-- | makedef.pl | 3 | ||||
| -rw-r--r-- | mg.c | 6 | ||||
| -rw-r--r-- | op.c | 4 | ||||
| -rw-r--r-- | perl.h | 11 | ||||
| -rw-r--r-- | proto.h | 9 | ||||
| -rw-r--r-- | sv.c | 153 | ||||
| -rw-r--r-- | sv.h | 25 | ||||
| -rw-r--r-- | universal.c | 6 |
11 files changed, 12 insertions, 220 deletions
@@ -1554,19 +1554,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv)) || (type == SVt_IV && !SvROK(sv))) { if (SvIsUV(sv) -#ifdef PERL_OLD_COPY_ON_WRITE - || SvIsCOW(sv) -#endif ) Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv)); else Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv)); -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW_shared_hash(sv)) - PerlIO_printf(file, " (HASH)"); - else if (SvIsCOW_normal(sv)) - PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv)); -#endif (void)PerlIO_putc(file, '\n'); } @@ -2381,9 +2381,6 @@ s |STRLEN |sv_pos_b2u_midway|NN const U8 *const s|NN const U8 *const target \ s |void |assert_uft8_cache_coherent|NN const char *const func \ |STRLEN from_cache|STRLEN real|NN SV *const sv sn |char * |F0convert |NV nv|NN char *const endbuf|NN STRLEN *const len -# if defined(PERL_OLD_COPY_ON_WRITE) -sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|NN SV *after -# endif s |SV * |more_sv s |bool |sv_2iuv_common |NN SV *const sv s |void |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \ @@ -1697,9 +1697,6 @@ #define utf8_mg_len_cache_update(a,b,c) S_utf8_mg_len_cache_update(aTHX_ a,b,c) #define utf8_mg_pos_cache_update(a,b,c,d,e) S_utf8_mg_pos_cache_update(aTHX_ a,b,c,d,e) #define visit(a,b,c) S_visit(aTHX_ a,b,c) -# if defined(PERL_OLD_COPY_ON_WRITE) -#define sv_release_COW(a,b,c) S_sv_release_COW(aTHX_ a,b,c) -# endif # if defined(USE_ITHREADS) #define sv_dup_common(a,b) S_sv_dup_common(aTHX_ a,b) #define sv_dup_inc_multiple(a,b,c,d) S_sv_dup_inc_multiple(aTHX_ a,b,c,d) diff --git a/makedef.pl b/makedef.pl index 8a570830e2..362797ade7 100644 --- a/makedef.pl +++ b/makedef.pl @@ -285,8 +285,7 @@ else { ); } -unless ($define{'PERL_OLD_COPY_ON_WRITE'} - || $define{'PERL_NEW_COPY_ON_WRITE'}) { +unless ($define{'PERL_NEW_COPY_ON_WRITE'}) { ++$skip{Perl_sv_setsv_cow}; } @@ -3395,12 +3395,6 @@ S_restore_magic(pTHX_ const void *p) if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */ -#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)) - sv_force_normal_flags(sv, 0); -#endif if (mgs->mgs_flags) SvFLAGS(sv) |= mgs->mgs_flags; else @@ -11949,9 +11949,7 @@ Perl_ck_svconst(pTHX_ OP *o) SV * const sv = cSVOPo->op_sv; PERL_ARGS_ASSERT_CK_SVCONST; PERL_UNUSED_CONTEXT; -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) sv_force_normal(sv); -#elif defined(PERL_NEW_COPY_ON_WRITE) +#ifdef PERL_NEW_COPY_ON_WRITE /* Since the read-only flag may be used to protect a string buffer, we cannot do copy-on-write with existing read-only scalars that are not already copy-on-write scalars. To allow $_ = "hello" to do COW with @@ -2644,16 +2644,12 @@ typedef struct padnamelist PADNAMELIST; typedef struct padname PADNAME; /* enable PERL_NEW_COPY_ON_WRITE by default */ -#if !defined(PERL_OLD_COPY_ON_WRITE) && !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW) +#if !defined(PERL_NEW_COPY_ON_WRITE) && !defined(PERL_NO_COW) # define PERL_NEW_COPY_ON_WRITE #endif -#if defined(PERL_OLD_COPY_ON_WRITE) || defined(PERL_NEW_COPY_ON_WRITE) -# if defined(PERL_OLD_COPY_ON_WRITE) && defined(PERL_NEW_COPY_ON_WRITE) -# error PERL_OLD_COPY_ON_WRITE and PERL_NEW_COPY_ON_WRITE are exclusive -# else +#ifdef PERL_NEW_COPY_ON_WRITE # define PERL_ANY_COW -# endif #else # define PERL_SAWAMPERSAND #endif @@ -4996,9 +4992,6 @@ EXTCONST char PL_bincompat_options[] = # ifdef PERL_NEED_TIMESBASE " PERL_NEED_TIMESBASE" # endif -# ifdef PERL_OLD_COPY_ON_WRITE - " PERL_OLD_COPY_ON_WRITE" -# endif # ifdef PERL_POISON " PERL_POISON" # endif @@ -7708,15 +7708,6 @@ STATIC I32 S_visit(pTHX_ SVFUNC_t f, const U32 flags, const U32 mask) #define PERL_ARGS_ASSERT_VISIT \ assert(f) -# if defined(PERL_OLD_COPY_ON_WRITE) -STATIC void S_sv_release_COW(pTHX_ SV *sv, const char *pvx, SV *after) - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2) - __attribute__nonnull__(pTHX_3); -#define PERL_ARGS_ASSERT_SV_RELEASE_COW \ - assert(sv); assert(pvx); assert(after) - -# endif # if defined(USE_ITHREADS) STATIC SV* S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param) __attribute__warn_unused_result__ @@ -125,11 +125,6 @@ # define ASSERT_UTF8_CACHE(cache) NOOP #endif -#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)) -#endif - /* ============================================================================ =head1 Allocation and deallocation of SVs. @@ -2500,11 +2495,6 @@ Perl_sv_2iv_flags(pTHX_ SV *const sv, const I32 flags) } if (SvTHINKFIRST(sv)) { -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) { - sv_force_normal_flags(sv, 0); - } -#endif if (SvREADONLY(sv) && !SvOK(sv)) { if (ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); @@ -2588,11 +2578,6 @@ Perl_sv_2uv_flags(pTHX_ SV *const sv, const I32 flags) } if (SvTHINKFIRST(sv)) { -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) { - sv_force_normal_flags(sv, 0); - } -#endif if (SvREADONLY(sv) && !SvOK(sv)) { if (ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); @@ -2674,11 +2659,6 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags) } return PTR2NV(SvRV(sv)); } -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) { - sv_force_normal_flags(sv, 0); - } -#endif if (SvREADONLY(sv) && !SvOK(sv)) { if (ckWARN(WARN_UNINITIALIZED)) report_uninit(sv); @@ -4641,14 +4621,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) } else if (flags & SV_COW_SHARED_HASH_KEYS && -#ifdef PERL_OLD_COPY_ON_WRITE - ( sflags & SVf_IsCOW - || ( (sflags & CAN_COW_MASK) == CAN_COW_FLAGS - && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS - && SvTYPE(sstr) >= SVt_PVIV && len - ) - ) -#elif defined(PERL_NEW_COPY_ON_WRITE) +#ifdef PERL_NEW_COPY_ON_WRITE (sflags & SVf_IsCOW ? (!len || ( (CHECK_COWBUF_THRESHOLD(cur,len) || SvLEN(dstr) < cur+1) @@ -4675,13 +4648,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) #ifdef PERL_ANY_COW if (!(sflags & SVf_IsCOW)) { SvIsCOW_on(sstr); -# ifdef PERL_OLD_COPY_ON_WRITE - /* Make the source SV into a loop of 1. - (about to become 2) */ - SV_COW_NEXT_SV_SET(sstr, sstr); -# else CowREFCNT(sstr) = 0; -# endif } #endif if (SvPVX_const(dstr)) { /* we know that dtype >= SVt_PV */ @@ -4690,18 +4657,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) #ifdef PERL_ANY_COW if (len) { -# ifdef PERL_OLD_COPY_ON_WRITE - assert (SvTYPE(dstr) >= SVt_PVIV); - /* SvIsCOW_normal */ - /* splice us in between source and next-after-source. */ - SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr)); - SV_COW_NEXT_SV_SET(sstr, dstr); -# else if (sflags & SVf_IsCOW) { sv_buf_to_rw(sstr); } CowREFCNT(sstr)++; -# endif SvPV_set(dstr, SvPVX_mutable(sstr)); sv_buf_to_ro(sstr); } else @@ -4786,11 +4745,7 @@ Perl_sv_setsv_mg(pTHX_ SV *const dstr, SV *const sstr) } #ifdef PERL_ANY_COW -# ifdef PERL_OLD_COPY_ON_WRITE -# define SVt_COW SVt_PVIV -# else # define SVt_COW SVt_PV -# endif SV * Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) { @@ -4823,12 +4778,6 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) assert (SvPOK(sstr)); assert (SvPOKp(sstr)); -# ifdef PERL_OLD_COPY_ON_WRITE - assert (!SvIOK(sstr)); - assert (!SvIOKp(sstr)); - assert (!SvNOK(sstr)); - assert (!SvNOKp(sstr)); -# endif if (SvIsCOW(sstr)) { @@ -4839,32 +4788,20 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) new_pv = HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)))); goto common_exit; } -# ifdef PERL_OLD_COPY_ON_WRITE - SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr)); -# else assert(SvCUR(sstr)+1 < SvLEN(sstr)); assert(CowREFCNT(sstr) < SV_COW_REFCNT_MAX); -# endif } else { assert ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS); SvUPGRADE(sstr, SVt_COW); SvIsCOW_on(sstr); DEBUG_C(PerlIO_printf(Perl_debug_log, "Fast copy on write: Converting sstr to COW\n")); -# ifdef PERL_OLD_COPY_ON_WRITE - SV_COW_NEXT_SV_SET(dstr, sstr); -# else CowREFCNT(sstr) = 0; -# endif } -# ifdef PERL_OLD_COPY_ON_WRITE - SV_COW_NEXT_SV_SET(sstr, dstr); -# else # ifdef PERL_DEBUG_READONLY_COW if (already) sv_buf_to_rw(sstr); # endif CowREFCNT(sstr)++; -# endif new_pv = SvPVX_mutable(sstr); sv_buf_to_ro(sstr); @@ -5120,44 +5057,6 @@ Perl_sv_usepvn_flags(pTHX_ SV *const sv, char *ptr, const STRLEN len, const U32 SvSETMAGIC(sv); } -#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 - (which it can do by means other than releasing copy-on-write Svs) - or by changing the other copy-on-write SVs in the loop. */ -STATIC void -S_sv_release_COW(pTHX_ SV *sv, const char *pvx, SV *after) -{ - PERL_ARGS_ASSERT_SV_RELEASE_COW; - - { /* this SV was SvIsCOW_normal(sv) */ - /* we need to find the SV pointing to us. */ - SV *current = SV_COW_NEXT_SV(after); - - if (current == sv) { - /* The SV we point to points back to us (there were only two of us - in the loop.) - Hence other SV is no longer copy on write either. */ - SvIsCOW_off(after); - sv_buf_to_rw(after); - } else { - /* We need to follow the pointers around the loop. */ - SV *next; - while ((next = SV_COW_NEXT_SV(current)) != sv) { - assert (next); - current = next; - /* don't loop forever if the structure is bust, and we have - a pointer into a closed loop. */ - assert (current != after); - assert (SvPVX_const(current) == pvx); - } - /* Make the SV before us point to the SV after us. */ - SV_COW_NEXT_SV_SET(current, after); - } - } -} -#endif /* =for apidoc sv_force_normal_flags @@ -5190,12 +5089,6 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags) const char * const pvx = SvPVX_const(sv); const STRLEN len = SvLEN(sv); const STRLEN cur = SvCUR(sv); -# ifdef PERL_OLD_COPY_ON_WRITE - /* next COW sv in the loop. If len is 0 then this is a shared-hash - key scalar, so we mustn't attempt to call SV_COW_NEXT_SV(), as - we'll fail an assertion. */ - SV * const next = len ? SV_COW_NEXT_SV(sv) : 0; -# endif if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, @@ -5239,9 +5132,6 @@ S_sv_uncow(pTHX_ SV * const sv, const U32 flags) *SvEND(sv) = '\0'; } if (len) { -# ifdef PERL_OLD_COPY_ON_WRITE - sv_release_COW(sv, pvx, next); -# endif } else { unshare_hek(SvSHARED_HEK_FROM_PV(pvx)); } @@ -5742,10 +5632,6 @@ Perl_sv_magicext_mglob(pTHX_ SV *sv) vivify_defelem(sv); sv = LvTARG(sv); } -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); -#endif return sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob, 0, 0); } @@ -5791,10 +5677,6 @@ Perl_sv_magic(pTHX_ SV *const sv, SV *const obj, const int how, vtable = (vtable_index == magic_vtable_max) ? NULL : PL_magic_vtables + vtable_index; -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); -#endif if (SvREADONLY(sv)) { if ( !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how) @@ -6426,28 +6308,6 @@ Perl_sv_replace(pTHX_ SV *const sv, SV *const nsv) } -#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. */ - SV *next; - SV *current = nsv; - while ((next = SV_COW_NEXT_SV(current)) != nsv) { - assert(next); - current = next; - assert(SvPVX_const(current) == SvPVX_const(nsv)); - } - /* Make the SV before us point to the SV after us. */ - if (DEBUG_C_TEST) { - PerlIO_printf(Perl_debug_log, "previous is\n"); - sv_dump(current); - PerlIO_printf(Perl_debug_log, - "move it from 0x%"UVxf" to 0x%"UVxf"\n", - (UV) SV_COW_NEXT_SV(current), (UV) sv); - } - SV_COW_NEXT_SV_SET(current, sv); - } -#endif SvREFCNT(sv) = refcnt; SvFLAGS(nsv) |= SVTYPEMASK; /* Mark as freed */ SvREFCNT(nsv) = 0; @@ -6734,24 +6594,17 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) sv_dump(sv); } if (SvLEN(sv)) { -# ifdef PERL_OLD_COPY_ON_WRITE - sv_release_COW(sv, SvPVX_const(sv), SV_COW_NEXT_SV(sv)); -# else if (CowREFCNT(sv)) { sv_buf_to_rw(sv); CowREFCNT(sv)--; sv_buf_to_ro(sv); SvLEN_set(sv, 0); } -# endif } else { unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv))); } } -# ifdef PERL_OLD_COPY_ON_WRITE - else -# endif if (SvLEN(sv)) { Safefree(SvPVX_mutable(sv)); } @@ -8078,10 +7931,6 @@ Perl_sv_collxfrm_flags(pTHX_ SV *const sv, STRLEN *const nxp, const I32 flags) s = SvPV_flags_const(sv, len, flags); if ((xf = mem_collxfrm(s, len, &xlen))) { if (! mg) { -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); -#endif mg = sv_magicext(sv, 0, PERL_MAGIC_collxfrm, &PL_vtbl_collxfrm, 0, 0); assert(mg); @@ -1820,6 +1820,9 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>. #define SV_HAS_TRAILING_NUL 256 #define SV_COW_SHARED_HASH_KEYS 512 /* This one is only enabled for PERL_OLD_COPY_ON_WRITE */ +/* XXX This flag actually enabled for any COW. But it appears not to do + anything. Can we just remove it? Or will it serve some future + purpose. */ #define SV_COW_OTHER_PVS 1024 /* Make sv_2pv_flags return NULL if something is undefined. */ #define SV_UNDEF_RETURNS_NULL 2048 @@ -1861,26 +1864,13 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>. #define SV_CHECK_THINKFIRST_COW_DROP(sv) if (SvTHINKFIRST(sv)) \ sv_force_normal_flags(sv, SV_COW_DROP_PV) -#ifdef PERL_OLD_COPY_ON_WRITE -#define SvRELEASE_IVX(sv) \ - ((SvIsCOW(sv) ? sv_force_normal_flags(sv, 0) : (void) 0), 0) -# define SvIsCOW_normal(sv) (SvIsCOW(sv) && SvLEN(sv)) -# define SvRELEASE_IVX_(sv) SvRELEASE_IVX(sv), -# define SvCANCOW(sv) \ - (SvIsCOW(sv) || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS) -/* This is a pessimistic view. Scalar must be purely a read-write PV to 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| \ - SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) -#else -# define SvRELEASE_IVX(sv) 0 +#define SvRELEASE_IVX(sv) 0 /* This little game brought to you by the need to shut this warning up: mg.c: In function 'Perl_magic_get': mg.c:1024: warning: left-hand operand of comma expression has no effect */ -# define SvRELEASE_IVX_(sv) /**/ -# ifdef PERL_NEW_COPY_ON_WRITE +#define SvRELEASE_IVX_(sv) /**/ +#ifdef PERL_NEW_COPY_ON_WRITE # define SvCANCOW(sv) \ (SvIsCOW(sv) \ ? SvLEN(sv) ? CowREFCNT(sv) != SV_COW_REFCNT_MAX : 1 \ @@ -1891,8 +1881,7 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect # define SV_COW_REFCNT_MAX ((1 << sizeof(U8)*8) - 1) # define CAN_COW_MASK (SVf_POK|SVf_ROK|SVp_POK|SVf_FAKE| \ SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) -# endif -#endif /* PERL_OLD_COPY_ON_WRITE */ +#endif #define CAN_COW_FLAGS (SVp_POK|SVf_POK) diff --git a/universal.c b/universal.c index 58b010b4d5..9b34df9753 100644 --- a/universal.c +++ b/universal.c @@ -563,9 +563,6 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ } else if (items == 2) { if (SvTRUE(ST(1))) { -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) sv_force_normal(sv); -#endif SvFLAGS(sv) |= SVf_READONLY; XSRETURN_YES; } @@ -592,9 +589,6 @@ XS(XS_constant__make_const) /* This is dangerous stuff. */ sv = SvRV(svz); -#ifdef PERL_OLD_COPY_ON_WRITE - if (SvIsCOW(sv)) sv_force_normal(sv); -#endif SvREADONLY_on(sv); if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) { /* for constant.pm; nobody else should be calling this |