From 5302ffd479952aac7b09adb0db5642b6376ad312 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Wed, 17 Jan 2007 18:24:50 +0000 Subject: [PATCH] Make PERL_OLD_COPY_ON_WRITE build again. Inline Perl_sv_release_IVX(). (Currently it fails ext/Compress/Raw/Zlib/t/07bufsize.t) p4raw-id: //depot/perl@29853 --- embed.fnc | 6 +----- embed.h | 12 +----------- global.sym | 1 - makedef.pl | 1 - proto.h | 10 ++-------- sv.c | 35 ++++++++++++++++++----------------- sv.h | 4 ++-- 7 files changed, 24 insertions(+), 45 deletions(-) diff --git a/embed.fnc b/embed.fnc index 0847142..91bb0a5 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1079,10 +1079,6 @@ Ap |void |sys_intern_init ApR |char * |custom_op_name |NN const OP* op ApR |char * |custom_op_desc |NN const OP* op -#if defined(PERL_OLD_COPY_ON_WRITE) -pMX |int |sv_release_IVX |NN SV *sv -#endif - Adp |void |sv_nosharing |NULLOK SV *sv Adpbm |void |sv_nolocking |NULLOK SV *sv #ifdef NO_MATHOMS @@ -1450,7 +1446,7 @@ s |STRLEN |sv_pos_b2u_midway|NN const U8 *s|NN const U8 *const target \ |NN const U8 *end|STRLEN endu sn |char * |F0convert |NV nv|NN char *endbuf|NN STRLEN *len # if defined(PERL_OLD_COPY_ON_WRITE) -sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|STRLEN len|NN SV *after +sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|NN SV *after # endif s |SV * |more_sv s |void * |more_bodies |svtype sv_type diff --git a/embed.h b/embed.h index eae6f3d..969427f 100644 --- a/embed.h +++ b/embed.h @@ -1076,11 +1076,6 @@ #endif #define custom_op_name Perl_custom_op_name #define custom_op_desc Perl_custom_op_desc -#if defined(PERL_OLD_COPY_ON_WRITE) -#ifdef PERL_CORE -#define sv_release_IVX Perl_sv_release_IVX -#endif -#endif #define sv_nosharing Perl_sv_nosharing #ifdef NO_MATHOMS #else @@ -3279,11 +3274,6 @@ #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_OLD_COPY_ON_WRITE) -#ifdef PERL_CORE -#define sv_release_IVX(a) Perl_sv_release_IVX(aTHX_ a) -#endif -#endif #define sv_nosharing(a) Perl_sv_nosharing(aTHX_ a) #ifdef NO_MATHOMS #else @@ -3649,7 +3639,7 @@ #endif # if defined(PERL_OLD_COPY_ON_WRITE) #ifdef PERL_CORE -#define sv_release_COW(a,b,c,d) S_sv_release_COW(aTHX_ a,b,c,d) +#define sv_release_COW(a,b,c) S_sv_release_COW(aTHX_ a,b,c) #endif # endif #ifdef PERL_CORE diff --git a/global.sym b/global.sym index 21d7532..4ab45b5 100644 --- a/global.sym +++ b/global.sym @@ -668,7 +668,6 @@ Perl_sys_intern_clear Perl_sys_intern_init Perl_custom_op_name Perl_custom_op_desc -Perl_sv_release_IVX Perl_sv_nosharing Perl_sv_nolocking Perl_sv_nounlocking diff --git a/makedef.pl b/makedef.pl index 6c08033..ceb6e3f 100644 --- a/makedef.pl +++ b/makedef.pl @@ -629,7 +629,6 @@ else { unless ($define{'PERL_OLD_COPY_ON_WRITE'}) { skip_symbols [qw( Perl_sv_setsv_cow - Perl_sv_release_IVX )]; } diff --git a/proto.h b/proto.h index 662f09c..4465055 100644 --- a/proto.h +++ b/proto.h @@ -2908,12 +2908,6 @@ PERL_CALLCONV char * Perl_custom_op_desc(pTHX_ const OP* op) __attribute__nonnull__(pTHX_1); -#if defined(PERL_OLD_COPY_ON_WRITE) -PERL_CALLCONV int Perl_sv_release_IVX(pTHX_ SV *sv) - __attribute__nonnull__(pTHX_1); - -#endif - PERL_CALLCONV void Perl_sv_nosharing(pTHX_ SV *sv); /* PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv); */ #ifdef NO_MATHOMS @@ -3890,10 +3884,10 @@ STATIC char * S_F0convert(NV nv, char *endbuf, STRLEN *len) __attribute__nonnull__(3); # if defined(PERL_OLD_COPY_ON_WRITE) -STATIC void S_sv_release_COW(pTHX_ SV *sv, const char *pvx, STRLEN len, SV *after) +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_4); + __attribute__nonnull__(pTHX_3); # endif STATIC SV * S_more_sv(pTHX); diff --git a/sv.c b/sv.c index 2d4fc39..787b0c5 100644 --- a/sv.c +++ b/sv.c @@ -4010,9 +4010,9 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags) (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_ register SV *sv, const char *pvx, STRLEN len, SV *after) +S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, SV *after) { - if (len) { /* this SV was SvIsCOW_normal(sv) */ + { /* this SV was SvIsCOW_normal(sv) */ /* we need to find the SV pointing to us. */ SV *current = SV_COW_NEXT_SV(after); @@ -4036,19 +4036,8 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after) /* Make the SV before us point to the SV after us. */ SV_COW_NEXT_SV_SET(current, after); } - } else { - unshare_hek(SvSHARED_HEK_FROM_PV(pvx)); } } - -int -Perl_sv_release_IVX(pTHX_ register SV *sv) -{ - if (SvIsCOW(sv)) - sv_force_normal_flags(sv, 0); - SvOOK_off(sv); - return 0; -} #endif /* =for apidoc sv_force_normal_flags @@ -4077,7 +4066,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) const char * const pvx = SvPVX_const(sv); const STRLEN len = SvLEN(sv); const STRLEN cur = SvCUR(sv); - SV * const next = SV_COW_NEXT_SV(sv); /* next COW sv in the loop. */ + /* 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; + if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, "Copy on write: Force normal %ld\n", @@ -4098,7 +4091,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) SvCUR_set(sv, cur); *SvEND(sv) = '\0'; } - sv_release_COW(sv, pvx, len, next); + if (len) { + sv_release_COW(sv, pvx, next); + } else { + unshare_hek(SvSHARED_HEK_FROM_PV(pvx)); + } if (DEBUG_C_TEST) { sv_dump(sv); } @@ -5196,8 +5193,12 @@ Perl_sv_clear(pTHX_ register SV *sv) PerlIO_printf(Perl_debug_log, "Copy on write: clear\n"); sv_dump(sv); } - sv_release_COW(sv, SvPVX_const(sv), SvLEN(sv), - SV_COW_NEXT_SV(sv)); + if (SvLEN(sv)) { + sv_release_COW(sv, SvPVX_const(sv), SV_COW_NEXT_SV(sv)); + } else { + unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv))); + } + /* And drop it here. */ SvFAKE_off(sv); } else if (SvLEN(sv)) { diff --git a/sv.h b/sv.h index 276144d..52b3254 100644 --- a/sv.h +++ b/sv.h @@ -1865,8 +1865,8 @@ Like C but doesn't process magic. sv_force_normal_flags(sv, SV_COW_DROP_PV) #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 SvRELEASE_IVX(sv) \ + ((SvIsCOW(sv) ? sv_force_normal_flags(sv, 0) : (void) 0), SvOOK_off(sv)) # define SvIsCOW_normal(sv) (SvIsCOW(sv) && SvLEN(sv)) #else # define SvRELEASE_IVX(sv) SvOOK_off(sv) -- 2.7.4