From: Nicholas Clark Date: Wed, 4 Sep 2002 21:52:47 +0000 (+0100) Subject: copy on write: fixes and debugging X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e419cbc5a3c0f956a8a75e89daa7813b79960bf5;p=p5sagit%2Fp5-mst-13.2.git copy on write: fixes and debugging Subject: what copies scalars in ithreads? Message-ID: <20020904205247.GA280@Bagpuss.unfortu.net> p4raw-id: //depot/perl@17847 --- diff --git a/sv.c b/sv.c index 5627656..824cc8e 100644 --- a/sv.c +++ b/sv.c @@ -27,9 +27,9 @@ #define SV_COW_NEXT_SV(sv) INT2PTR(SV *,SvUVX(sv)) /* This is a pessamistic view. Scalar must be purely a read-write PV to copy- on-write. */ -#define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVf_IOK|SVf_NOK|SVf_POK| \ - SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE|SVf_OOK| \ - SVf_BREAK|SVf_READONLY|SVf_AMAGIC) +#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_AMAGIC) #define CAN_COW_FLAGS (SVp_POK|SVf_POK) #endif @@ -3932,8 +3932,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, "Copy on write: sstr --> dstr\n"); - Perl_sv_dump(sstr); - Perl_sv_dump(dstr); + sv_dump(sstr); + sv_dump(dstr); } if (!isSwipe) { /* I believe I should acquire a global SV mutex if @@ -4258,6 +4258,7 @@ S_sv_release_COW(pTHX_ register SV *sv, char *pvx, STRLEN cur, STRLEN len, /* don't loop forever if the structure is bust, and we have a pointer into a closed loop. */ assert (current != after); + assert (SvPVX(current) == pvx); } /* Make the SV before us point to the SV after us. */ SV_COW_NEXT_SV(current) = after; @@ -4307,7 +4308,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) PerlIO_printf(Perl_debug_log, "Copy on write: Force normal %ld\n", (long) flags); - Perl_sv_dump(sv); + sv_dump(sv); } SvFAKE_off(sv); SvREADONLY_off(sv); @@ -4323,9 +4324,9 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) SvCUR(sv) = cur; *SvEND(sv) = '\0'; } - S_sv_release_COW(sv, pvx, cur, len, hash, next); + sv_release_COW(sv, pvx, cur, len, hash, next); if (DEBUG_C_TEST) { - Perl_sv_dump(sv); + sv_dump(sv); } } else if (PL_curcop != &PL_compiling) @@ -5228,9 +5229,9 @@ Perl_sv_clear(pTHX_ register SV *sv) then recheck the COW status. */ if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, "Copy on write: clear\n"); - Perl_sv_dump(sv); + sv_dump(sv); } - S_sv_release_COW(sv, SvPVX(sv), SvCUR(sv), SvLEN(sv), + sv_release_COW(sv, SvPVX(sv), SvCUR(sv), SvLEN(sv), SvUVX(sv), SV_COW_NEXT_SV(sv)); /* And drop it here. */ SvFAKE_off(sv);