From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 7 Sep 2002 00:20:53 +0000 (+0100)
Subject: COW for ithreads (was Re: what copies scalars in ithreads?)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d3d0e6f1233c0621cb4930e677ea82e761029cf7;p=p5sagit%2Fp5-mst-13.2.git

COW for ithreads (was Re: what copies scalars in ithreads?)
Message-ID: <20020906232052.GB901@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@17873
---

diff --git a/op.c b/op.c
index 5c55f0d..a3876c4 100644
--- a/op.c
+++ b/op.c
@@ -610,7 +610,12 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
 	SvPADTMP_off(PL_curpad[po]);
 #ifdef USE_ITHREADS
-	SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
+#ifdef PERL_COPY_ON_WRITE
+	if (SvIsCOW(PL_curpad[po])) {
+	    sv_force_normal_flags(PL_curpad[po], SV_COW_DROP_PV);
+	} else
+#endif
+	    SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
 #endif
     }
     if ((I32)po < PL_padix)
diff --git a/sv.c b/sv.c
index 6db4455..91b1926 100644
--- a/sv.c
+++ b/sv.c
@@ -5080,6 +5080,27 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
     sv_clear(sv);
     assert(!SvREFCNT(sv));
     StructCopy(nsv,sv,SV);
+#ifdef PERL_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(current) == SvPVX(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 "UVxf" to "UVxf"\n",
+			  (UV) SV_COW_NEXT_SV(current), (UV) sv);
+	}
+	SV_COW_NEXT_SV(current) = sv;
+    }
+#endif
     SvREFCNT(sv) = refcnt;
     SvFLAGS(nsv) |= SVTYPEMASK;		/* Mark as freed */
     del_SV(nsv);
@@ -9179,7 +9200,7 @@ void
 Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
 {
     if (SvROK(sstr)) {
-        SvRV(dstr) = SvWEAKREF(sstr)
+	SvRV(dstr) = SvWEAKREF(sstr)
 		     ? sv_dup(SvRV(sstr), param)
 		     : sv_dup_inc(SvRV(sstr), param);
     }
@@ -9188,6 +9209,12 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
 	if (SvLEN(sstr)) {
 	    /* Normal PV - clone whole allocated space */
 	    SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
+	    if (SvREADONLY(sstr) && SvFAKE(sstr)) {
+		/* Not that normal - actually sstr is copy on write.
+		   But we are a true, independant SV, so:  */
+		SvREADONLY_off(dstr);
+		SvFAKE_off(dstr);
+	    }
 	}
 	else {
 	    /* Special case - not normally malloced for some reason */
@@ -9200,7 +9227,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param)
 	    else {
 		/* Some other special case - random pointer */
 		SvPVX(dstr) = SvPVX(sstr);		
-            }
+	    }
 	}
     }
     else {