COW regexps:

Subject: [PATCH] Copy on write for $& and $1...
Message-ID: <20030209230008.GF299@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@18726

1 files changed, 25 insertions, 8 deletions

diff --git a/regexec.c b/regexec.c
index 40f33d493a..4135d3622f 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2023,17 +2023,28 @@ got_it:
 
     /* make sure $`, $&, $', and $digit will work later */
     if ( !(flags & REXEC_NOT_FIRST) ) {
-	if (RX_MATCH_COPIED(prog)) {
-	    Safefree(prog->subbeg);
-	    RX_MATCH_COPIED_off(prog);
-	}
+	RX_MATCH_COPY_FREE(prog);
 	if (flags & REXEC_COPY_STR) {
 	    I32 i = PL_regeol - startpos + (stringarg - strbeg);
-
-	    s = savepvn(strbeg, i);
-	    prog->subbeg = s;
+#ifdef PERL_COPY_ON_WRITE
+	    if ((SvIsCOW(sv)
+		 || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
+		if (DEBUG_C_TEST) {
+		    PerlIO_printf(Perl_debug_log,
+				  "Copy on write: regexp capture, type %d\n",
+				  (int) SvTYPE(sv));
+		}
+		prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
+		prog->subbeg = SvPVX(prog->saved_copy);
+		assert (SvPOKp(prog->saved_copy));
+	    } else
+#endif
+	    {
+		RX_MATCH_COPIED_on(prog);
+		s = savepvn(strbeg, i);
+		prog->subbeg = s;
+	    }
 	    prog->sublen = i;
-	    RX_MATCH_COPIED_on(prog);
 	}
 	else {
 	    prog->subbeg = strbeg;
@@ -2123,6 +2134,9 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
 		$` inside (?{}) could fail... */
 	    PL_reg_oldsaved = prog->subbeg;
 	    PL_reg_oldsavedlen = prog->sublen;
+#ifdef PERL_COPY_ON_WRITE
+	    PL_nrs = prog->saved_copy;
+#endif
 	    RX_MATCH_COPIED_off(prog);
 	}
 	else
@@ -4555,6 +4569,9 @@ restore_pos(pTHX_ void *arg)
 	if (PL_reg_oldsaved) {
 	    PL_reg_re->subbeg = PL_reg_oldsaved;
 	    PL_reg_re->sublen = PL_reg_oldsavedlen;
+#ifdef PERL_COPY_ON_WRITE
+	    PL_reg_re->saved_copy = PL_nrs;
+#endif
 	    RX_MATCH_COPIED_on(PL_reg_re);
 	}
 	PL_reg_magic->mg_len = PL_reg_oldpos;