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

diff --git a/embed.fnc b/embed.fnc
index 0847142..91bb0a5 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/sv.h
+++ b/sv.h
@@ -1865,8 +1865,8 @@ Like C<sv_catsv> 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)