From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 17 Jan 2007 18:24:50 +0000 (+0000)
Subject: Make PERL_OLD_COPY_ON_WRITE build again. Inline Perl_sv_release_IVX().
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5302ffd479952aac7b09adb0db5642b6376ad312;p=p5sagit%2Fp5-mst-13.2.git
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
--- 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<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)