develooper Front page | perl.perl5.porters | Postings from November 1999

Patch for Threading and Regexps

Thread Next
From:
Brian Mancuso
Date:
November 19, 1999 12:05
Subject:
Patch for Threading and Regexps
Message ID:
199911192001.PAA24813@ll.mit.edu
Below is a patch that decouples the match variables from the
op tree and places them in the thread structure. This will
fix bug 19990707.008: overwriting of regexp match variables
by multiple threads.

Enjoy,

Brian Mancuso
brianm@ll.mit.edu

--- perl5.005_62-bugged/mg.c	Sun Oct 10 16:07:05 1999
+++ perl5.005_62/mg.c	Wed Nov 17 10:48:47 1999
@@ -305,8 +305,8 @@
 	if (paren < 0)
 	    return 0;
 	if (paren <= rx->nparens &&
-	    (s = rx->startp[paren]) != -1 &&
-	    (t = rx->endp[paren]) != -1)
+	    (s = get_match_node(rx)->startp[paren]) != -1 &&
+	    (t = get_match_node(rx)->endp[paren]) != -1)
 	    {
 		if (mg->mg_obj)		/* @+ */
 		    i = t;
@@ -337,8 +337,8 @@
 	    paren = atoi(mg->mg_ptr);
 	  getparen:
 	    if (paren <= rx->nparens &&
-		(s1 = rx->startp[paren]) != -1 &&
-		(t1 = rx->endp[paren]) != -1)
+		(s1 = get_match_node(rx)->startp[paren]) != -1 &&
+		(t1 = get_match_node(rx)->endp[paren]) != -1)
 	    {
 		i = t1 - s1;
 		if (i >= 0)
@@ -355,8 +355,8 @@
 	return 0;
     case '`':
 	if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
-	    if (rx->startp[0] != -1) {
-		i = rx->startp[0];
+	    if (get_match_node(rx)->startp[0] != -1) {
+		i = get_match_node(rx)->startp[0];
 		if (i >= 0)
 		    return i;
 	    }
@@ -364,8 +364,8 @@
 	return 0;
     case '\'':
 	if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
-	    if (rx->endp[0] != -1) {
-		i = rx->sublen - rx->endp[0];
+	    if (get_match_node(rx)->endp[0] != -1) {
+		i = get_match_node(rx)->sublen - get_match_node(rx)->endp[0];
 		if (i >= 0)
 		    return i;
 	    }
@@ -520,11 +520,11 @@
 	    paren = atoi(mg->mg_ptr);
 	  getparen:
 	    if (paren <= rx->nparens &&
-		(s1 = rx->startp[paren]) != -1 &&
-		(t1 = rx->endp[paren]) != -1)
+		(s1 = get_match_node(rx)->startp[paren]) != -1 &&
+		(t1 = get_match_node(rx)->endp[paren]) != -1)
 	    {
 		i = t1 - s1;
-		s = rx->subbeg + s1;
+		s = get_match_node(rx)->subbeg + s1;
 	      getrx:
 		if (i >= 0) {
 		    bool was_tainted;
@@ -551,8 +551,8 @@
 	break;
     case '`':
 	if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
-	    if ((s = rx->subbeg) && rx->startp[0] != -1) {
-		i = rx->startp[0];
+	    if ((s = get_match_node(rx)->subbeg) && get_match_node(rx)->startp[0] != -1) {
+		i = get_match_node(rx)->startp[0];
 		goto getrx;
 	    }
 	}
@@ -560,9 +560,9 @@
 	break;
     case '\'':
 	if (PL_curpm && (rx = PL_curpm->op_pmregexp)) {
-	    if (rx->subbeg && rx->endp[0] != -1) {
-		s = rx->subbeg + rx->endp[0];
-		i = rx->sublen - rx->endp[0];
+	    if (get_match_node(rx)->subbeg && get_match_node(rx)->endp[0] != -1) {
+		s = get_match_node(rx)->subbeg + get_match_node(rx)->endp[0];
+		i = get_match_node(rx)->sublen - get_match_node(rx)->endp[0];
 		goto getrx;
 	    }
 	}
--- perl5.005_62-bugged/pp.c	Tue Oct 12 01:16:27 1999
+++ perl5.005_62/pp.c	Wed Nov 17 10:48:47 1999
@@ -5070,14 +5070,14 @@
 			      1 /* minend */, sv, NULL, 0))
 	{
 	    TAINT_IF(RX_MATCH_TAINTED(rx));
-	    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+	    if (RX_MATCH_COPIED(rx) && get_match_node(rx)->subbeg != orig) {
 		m = s;
 		s = orig;
-		orig = rx->subbeg;
+		orig = get_match_node(rx)->subbeg;
 		s = orig + (m - s);
 		strend = s + (strend - m);
 	    }
-	    m = rx->startp[0] + orig;
+	    m = get_match_node(rx)->startp[0] + orig;
 	    dstr = NEWSV(32, m-s);
 	    sv_setpvn(dstr, s, m-s);
 	    if (make_mortal)
@@ -5085,8 +5085,8 @@
 	    XPUSHs(dstr);
 	    if (rx->nparens) {
 		for (i = 1; i <= rx->nparens; i++) {
-		    s = rx->startp[i] + orig;
-		    m = rx->endp[i] + orig;
+		    s = get_match_node(rx)->startp[i] + orig;
+		    m = get_match_node(rx)->endp[i] + orig;
 		    if (m && s) {
 			dstr = NEWSV(33, m-s);
 			sv_setpvn(dstr, s, m-s);
@@ -5098,7 +5098,7 @@
 		    XPUSHs(dstr);
 		}
 	    }
-	    s = rx->endp[0] + orig;
+	    s = get_match_node(rx)->endp[0] + orig;
 	}
     }
 
--- perl5.005_62-bugged/pp_ctl.c	Thu Oct 14 13:24:54 1999
+++ perl5.005_62/pp_ctl.c	Wed Nov 17 10:48:47 1999
@@ -193,16 +193,16 @@
 	    RETURNOP(pm->op_next);
 	}
     }
-    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+    if (RX_MATCH_COPIED(rx) && get_match_node(rx)->subbeg != orig) {
 	m = s;
 	s = orig;
-	cx->sb_orig = orig = rx->subbeg;
+	cx->sb_orig = orig = get_match_node(rx)->subbeg;
 	s = orig + (m - s);
 	cx->sb_strend = s + (cx->sb_strend - m);
     }
-    cx->sb_m = m = rx->startp[0] + orig;
+    cx->sb_m = m = get_match_node(rx)->startp[0] + orig;
     sv_catpvn(dstr, s, m-s);
-    cx->sb_s = rx->endp[0] + orig;
+    cx->sb_s = get_match_node(rx)->endp[0] + orig;
     cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
     rxres_save(&cx->sb_rxres, rx);
     RETURNOP(pm->op_pmreplstart);
@@ -223,16 +223,16 @@
 	*rsp = (void*)p;
     }
 
-    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? get_match_node(rx)->subbeg : Nullch);
     RX_MATCH_COPIED_off(rx);
 
     *p++ = rx->nparens;
 
-    *p++ = PTR2UV(rx->subbeg);
-    *p++ = (UV)rx->sublen;
+    *p++ = PTR2UV(get_match_node(rx)->subbeg);
+    *p++ = (UV)get_match_node(rx)->sublen;
     for (i = 0; i <= rx->nparens; ++i) {
-	*p++ = (UV)rx->startp[i];
-	*p++ = (UV)rx->endp[i];
+	*p++ = (UV)get_match_node(rx)->startp[i];
+	*p++ = (UV)get_match_node(rx)->endp[i];
     }
 }
 
@@ -243,17 +243,17 @@
     U32 i;
 
     if (RX_MATCH_COPIED(rx))
-	Safefree(rx->subbeg);
+       Safefree(get_match_node(rx)->subbeg);
     RX_MATCH_COPIED_set(rx, *p);
     *p++ = 0;
 
     rx->nparens = *p++;
 
-    rx->subbeg = INT2PTR(char*,*p++);
-    rx->sublen = (I32)(*p++);
+    get_match_node(rx)->subbeg = INT2PTR(char*,*p++);
+    get_match_node(rx)->sublen = (I32)(*p++);
     for (i = 0; i <= rx->nparens; ++i) {
-	rx->startp[i] = (I32)(*p++);
-	rx->endp[i] = (I32)(*p++);
+	get_match_node(rx)->startp[i] = (I32)(*p++);
+	get_match_node(rx)->endp[i] = (I32)(*p++);
     }
 }
 
--- perl5.005_62-bugged/pp_hot.c	Tue Oct 12 01:22:11 1999
+++ perl5.005_62/pp_hot.c	Wed Nov 17 10:48:47 1999
@@ -891,15 +891,15 @@
 
     /* XXXX What part of this is needed with true \G-support? */
     if (global = pm->op_pmflags & PMf_GLOBAL) {
-	rx->startp[0] = -1;
+	get_match_node(rx)->startp[0] = -1;
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* mg = mg_find(TARG, 'g');
 	    if (mg && mg->mg_len >= 0) {
 		if (!(rx->reganch & ROPT_GPOS_SEEN))
-		    rx->endp[0] = rx->startp[0] = mg->mg_len; 
+		    get_match_node(rx)->endp[0] = get_match_node(rx)->startp[0] = mg->mg_len; 
 		else if (rx->reganch & ROPT_ANCH_GPOS) {
 		    r_flags |= REXEC_IGNOREPOS;
-		    rx->endp[0] = rx->startp[0] = mg->mg_len; 
+		    get_match_node(rx)->endp[0] = get_match_node(rx)->startp[0] = mg->mg_len; 
 		}
 		minmatch = (mg->mg_flags & MGf_MINMATCH);
 		update_minmatch = 0;
@@ -918,8 +918,8 @@
     }
 
 play_it_again:
-    if (global && rx->startp[0] != -1) {
-	t = s = rx->endp[0] + truebase;
+    if (global && get_match_node(rx)->startp[0] != -1) {
+	t = s = get_match_node(rx)->endp[0] + truebase;
 	if ((s + rx->minlen) > strend)
 	    goto nope;
 	if (update_minmatch++)
@@ -966,15 +966,15 @@
 	for (i = !i; i <= iters; i++) {
 	    PUSHs(sv_newmortal());
 	    /*SUPPRESS 560*/
-	    if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
-		len = rx->endp[i] - rx->startp[i];
-		s = rx->startp[i] + truebase;
+	    if ((get_match_node(rx)->startp[i] != -1) && get_match_node(rx)->endp[i] != -1 ) {
+		len = get_match_node(rx)->endp[i] - get_match_node(rx)->startp[i];
+		s = get_match_node(rx)->startp[i] + truebase;
 		sv_setpvn(*SP, s, len);
 	    }
 	}
 	if (global) {
-	    had_zerolen = (rx->startp[0] != -1
-			   && rx->startp[0] == rx->endp[0]);
+	    had_zerolen = (get_match_node(rx)->startp[0] != -1
+			   && get_match_node(rx)->startp[0] == get_match_node(rx)->endp[0]);
 	    PUTBACK;			/* EVAL blocks may use stack */
 	    r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
 	    goto play_it_again;
@@ -993,9 +993,9 @@
 		sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
 		mg = mg_find(TARG, 'g');
 	    }
-	    if (rx->startp[0] != -1) {
-		mg->mg_len = rx->endp[0];
-		if (rx->startp[0] == rx->endp[0])
+	    if (get_match_node(rx)->startp[0] != -1) {
+		mg->mg_len = get_match_node(rx)->endp[0];
+		if (get_match_node(rx)->startp[0] == get_match_node(rx)->endp[0])
 		    mg->mg_flags |= MGf_MINMATCH;
 		else
 		    mg->mg_flags &= ~MGf_MINMATCH;
@@ -1013,28 +1013,28 @@
     if (pm->op_pmflags & PMf_ONCE)
 	pm->op_pmdynflags |= PMdf_USED;
     if (RX_MATCH_COPIED(rx))
-	Safefree(rx->subbeg);
+       Safefree(get_match_node(rx)->subbeg);
     RX_MATCH_COPIED_off(rx);
-    rx->subbeg = Nullch;
+    get_match_node(rx)->subbeg = Nullch;
     if (global) {
-	rx->subbeg = truebase;
-	rx->startp[0] = s - truebase;
-	rx->endp[0] = s - truebase + rx->minlen;
-	rx->sublen = strend - truebase;
+	get_match_node(rx)->subbeg = truebase;
+	get_match_node(rx)->startp[0] = s - truebase;
+	get_match_node(rx)->endp[0] = s - truebase + rx->minlen;
+	get_match_node(rx)->sublen = strend - truebase;
 	goto gotcha;
     } 
     if (PL_sawampersand) {
 	I32 off;
 
-	rx->subbeg = savepvn(t, strend - t);
-	rx->sublen = strend - t;
+	get_match_node(rx)->subbeg = savepvn(t, strend - t);
+	get_match_node(rx)->sublen = strend - t;
 	RX_MATCH_COPIED_on(rx);
-	off = rx->startp[0] = s - t;
-	rx->endp[0] = off + rx->minlen;
+	off = get_match_node(rx)->startp[0] = s - t;
+	get_match_node(rx)->endp[0] = off + rx->minlen;
     }
     else {			/* startp/endp are used by @- @+. */
-	rx->startp[0] = s - truebase;
-	rx->endp[0] = s - truebase + rx->minlen;
+	get_match_node(rx)->startp[0] = s - truebase;
+	get_match_node(rx)->endp[0] = s - truebase + rx->minlen;
     }
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
@@ -1715,8 +1715,8 @@
 	SvSCREAM_off(TARG);	/* disable possible screamer */
 	if (once) {
 	    rxtainted |= RX_MATCH_TAINTED(rx);
-	    m = orig + rx->startp[0];
-	    d = orig + rx->endp[0];
+	    m = orig + get_match_node(rx)->startp[0];
+	    d = orig + get_match_node(rx)->endp[0];
 	    s = orig;
 	    if (m - s > strend - d) {  /* faster to shorten from end */
 		if (clen) {
@@ -1759,7 +1759,7 @@
 		if (iters++ > maxiters)
 		    DIE(aTHX_ "Substitution loop");
 		rxtainted |= RX_MATCH_TAINTED(rx);
-		m = rx->startp[0] + orig;
+		m = get_match_node(rx)->startp[0] + orig;
 		/*SUPPRESS 560*/
 		if (i = m - s) {
 		    if (s != d)
@@ -1770,7 +1770,7 @@
 		    Copy(c, d, clen, char);
 		    d += clen;
 		}
-		s = rx->endp[0] + orig;
+		s = get_match_node(rx)->endp[0] + orig;
 	    } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
 				 TARG, NULL,
 				 /* don't match same null twice */
@@ -1819,16 +1819,16 @@
 	    if (iters++ > maxiters)
 		DIE(aTHX_ "Substitution loop");
 	    rxtainted |= RX_MATCH_TAINTED(rx);
-	    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+	    if (RX_MATCH_COPIED(rx) && get_match_node(rx)->subbeg != orig) {
 		m = s;
 		s = orig;
-		orig = rx->subbeg;
+		orig = get_match_node(rx)->subbeg;
 		s = orig + (m - s);
 		strend = s + (strend - m);
 	    }
-	    m = rx->startp[0] + orig;
+	    m = get_match_node(rx)->startp[0] + orig;
 	    sv_catpvn(dstr, s, m-s);
-	    s = rx->endp[0] + orig;
+	    s = get_match_node(rx)->endp[0] + orig;
 	    if (clen)
 		sv_catpvn(dstr, c, clen);
 	    if (once)
--- perl5.005_62-bugged/regcomp.c	Fri Oct 15 03:07:44 1999
+++ perl5.005_62/regcomp.c	Fri Nov 19 13:15:18 1999
@@ -202,6 +202,22 @@
 
 static void clear_re(pTHXo_ void *r);
 
+/* The number of regular expressions in a program. This is used
+ * by Perl_new_struct_thread to allocate space for match variables
+ * (one set for each regular expression). */
+
+U32 number_of_regexps = 0;
+
+/* The largest number of parentheses in any regular expression in
+ * the program. Instead of remembering the number of parentheses
+ * in each regular expression and allocating space based on that,
+ * we just remember the largest number, and allocate that amount
+ * of space for every regular expression. Most regexps will  then
+ * have more than enough space, there won't be any that don't have
+ * enough. */
+
+I32 largest_number_of_parentheses_so_far;
+
 STATIC void
 S_scan_commit(pTHX_ scan_data_t *data)
 {
@@ -831,6 +847,7 @@
     I32 sawplus = 0;
     I32 sawopen = 0;
     scan_data_t data;
+    int index;
 
     if (exp == NULL)
 	FAIL("NULL regexp argument");
@@ -884,15 +901,59 @@
     if (r == NULL)
 	FAIL("regexp out of space");
     r->refcnt = 1;
+
+    /* Give this regular expression a unique id. */
+
+#ifdef USE_THREADS
+
+    r->regexp_index = number_of_regexps++;
+
+    /* If the thread compiling this regular expression doesn't
+     * yet have space for its match variables, allocate space. */
+
+    if (PL_sizeof_match_vars_array == 0)
+      {
+	/* Start out with enough space for 4 sets of match variables. */
+
+	PL_sizeof_match_vars_array = 4;
+
+	/* Allocating space here. Note that the magic number for New
+	 * is probably wrong. */
+
+	New   (0,
+	      PL_matchvars,
+	      PL_sizeof_match_vars_array,
+	      match_vars_t);
+      }
+
+    /* Otherwise *some* space has been allocated for the match variables,
+     * make sure we have enough for one more set. */
+
+    else if (number_of_regexps > PL_sizeof_match_vars_array)
+      {
+	/* Guess we don't. Grow the space by multipling the
+	 * current size of the space by two. */
+
+	PL_sizeof_match_vars_array = PL_sizeof_match_vars_array * 2;
+
+	/* Realloc a block of that new size. */
+
+	Renew (PL_matchvars,
+	       PL_sizeof_match_vars_array,
+	       match_vars_t);
+      }
+
+#endif /* USE_THREADS */
+
     r->prelen = xend - exp;
     r->precomp = PL_regprecomp;
-    r->subbeg = NULL;
+    get_match_node(r)->subbeg = NULL;
     r->reganch = pm->op_pmflags & PMf_COMPILETIME;
     r->nparens = PL_regnpar - 1;	/* set early to validate backrefs */
 
     r->substrs = 0;			/* Useful during FAIL. */
-    r->startp = 0;			/* Useful during FAIL. */
-    r->endp = 0;			/* Useful during FAIL. */
+    get_match_node(r)->startp = 0;			/* Useful during FAIL. */
+    get_match_node(r)->endp = 0;			/* Useful during FAIL. */
 
     PL_regcomp_rx = r;
 
@@ -1101,8 +1162,29 @@
 	r->reganch |= ROPT_LOOKBEHIND_SEEN;
     if (PL_regseen & REG_SEEN_EVAL)
 	r->reganch |= ROPT_EVAL_SEEN;
-    Newz(1002, r->startp, PL_regnpar, I32);
-    Newz(1002, r->endp, PL_regnpar, I32);
+
+    /* Allocate space for parentheses data storage in the match
+     * variables set for this thread. */
+
+    Newz(1002, get_match_node(r)->startp, PL_regnpar, I32);
+    Newz(1002, get_match_node(r)->endp, PL_regnpar, I32);
+
+#ifdef USE_THREADS
+
+    /* Keep track of the the largest number of parentheses seen
+     * in any regular expression so far. This is used by
+     * Perl_new_struct_thread to allocate match variable space
+     * for a new thread. Rather then remember the amount of
+     * space required by each regular expression, just remember
+     * the most amount of space needed by any regular expression,
+     * and allocate that amount of space for all regular expressions
+     * for every thread. If you think this is inefficient, T.S. */
+    
+    if (largest_number_of_parentheses_so_far < PL_regnpar)
+      largest_number_of_parentheses_so_far = PL_regnpar;
+
+#endif USE_THREADS
+
     DEBUG_r(regdump(r));
     return(r);
 }
@@ -3365,9 +3447,9 @@
 		      (strlen(r->precomp) > 60 ? "..." : "")));
 
     if (r->precomp)
-	Safefree(r->precomp);
+       Safefree(r->precomp);
     if (RX_MATCH_COPIED(r))
-	Safefree(r->subbeg);
+       Safefree(get_match_node(r)->subbeg);
     if (r->substrs) {
 	if (r->anchored_substr)
 	    SvREFCNT_dec(r->anchored_substr);
@@ -3411,8 +3493,10 @@
 	Safefree(r->data->what);
 	Safefree(r->data);
     }
-    Safefree(r->startp);
-    Safefree(r->endp);
+    Safefree(get_match_node(r)->startp);
+    get_match_node(r)->startp == NULL;
+    Safefree(get_match_node(r)->endp);
+    get_match_node(r)->endp == NULL;
     Safefree(r);
 }
 
--- perl5.005_62-bugged/regexec.c	Sun Oct 10 15:25:52 1999
+++ perl5.005_62/regexec.c	Wed Nov 17 10:55:09 1999
@@ -1439,20 +1439,20 @@
     /* make sure $`, $&, $', and $digit will work later */
     if ( !(flags & REXEC_NOT_FIRST) ) {
 	if (RX_MATCH_COPIED(prog)) {
-	    Safefree(prog->subbeg);
+	    Safefree(get_match_node(prog)->subbeg);
 	    RX_MATCH_COPIED_off(prog);
 	}
 	if (flags & REXEC_COPY_STR) {
 	    I32 i = PL_regeol - startpos + (stringarg - strbeg);
 
 	    s = savepvn(strbeg, i);
-	    prog->subbeg = s;
-	    prog->sublen = i;
+	    get_match_node(prog)->subbeg = s;
+	    get_match_node(prog)->sublen = i;
 	    RX_MATCH_COPIED_on(prog);
 	}
 	else {
-	    prog->subbeg = strbeg;
-	    prog->sublen = PL_regeol - strbeg;	/* strend may have been modified */
+	    get_match_node(prog)->subbeg = strbeg;
+	    get_match_node(prog)->sublen = PL_regeol - strbeg;	/* strend may have been modified */
 	}
     }
     
@@ -1517,22 +1517,22 @@
 	PL_reg_oldcurpm = PL_curpm;
 	PL_curpm = PL_reg_curpm;
 	if (RX_MATCH_COPIED(prog)) {
-	    /*  Here is a serious problem: we cannot rewrite subbeg,
+	    /*  Here is a serious problem: we cannot rewrite match_vi.subbeg,
 		since it may be needed if this match fails.  Thus
 		$` inside (?{}) could fail... */
-	    PL_reg_oldsaved = prog->subbeg;
-	    PL_reg_oldsavedlen = prog->sublen;
+	    PL_reg_oldsaved = get_match_node(prog)->subbeg;
+	    PL_reg_oldsavedlen = get_match_node(prog)->sublen;
 	    RX_MATCH_COPIED_off(prog);
 	}
 	else
 	    PL_reg_oldsaved = Nullch;
-	prog->subbeg = PL_bostr;
-	prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
+	get_match_node(prog)->subbeg = PL_bostr;
+	get_match_node(prog)->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
     }
-    prog->startp[0] = startpos - PL_bostr;
+    get_match_node(prog)->startp[0] = startpos - PL_bostr;
     PL_reginput = startpos;
-    PL_regstartp = prog->startp;
-    PL_regendp = prog->endp;
+    PL_regstartp = get_match_node(prog)->startp;
+    PL_regendp = get_match_node(prog)->endp;
     PL_reglastparen = &prog->lastparen;
     prog->lastparen = 0;
     PL_regsize = 0;
@@ -1548,8 +1548,8 @@
     /* XXXX What this code is doing here?!!!  There should be no need
        to do this again and again, PL_reglastparen should take care of
        this!  */
-    sp = prog->startp;
-    ep = prog->endp;
+    sp = get_match_node(prog)->startp;
+    ep = get_match_node(prog)->endp;
     if (prog->nparens) {
 	for (i = prog->nparens; i >= 1; i--) {
 	    *++sp = -1;
@@ -1558,7 +1558,7 @@
     }
     REGCP_SET;
     if (regmatch(prog->program + 1)) {
-	prog->endp[0] = PL_reginput - PL_bostr;
+	get_match_node(prog)->endp[0] = PL_reginput - PL_bostr;
 	return 1;
     }
     REGCP_UNWIND;
@@ -3519,8 +3519,8 @@
     dTHR;
     if (PL_reg_eval_set) {
 	if (PL_reg_oldsaved) {
-	    PL_reg_re->subbeg = PL_reg_oldsaved;
-	    PL_reg_re->sublen = PL_reg_oldsavedlen;
+	    get_match_node(PL_reg_re)->subbeg = PL_reg_oldsaved;
+	    get_match_node(PL_reg_re)->sublen = PL_reg_oldsavedlen;
 	    RX_MATCH_COPIED_on(PL_reg_re);
 	}
 	PL_reg_magic->mg_len = PL_reg_oldpos;
--- perl5.005_62-bugged/util.c	Thu Oct 14 13:35:51 1999
+++ perl5.005_62/util.c	Thu Nov 18 15:24:15 1999
@@ -3349,6 +3349,7 @@
  * called. The use by ext/Thread/Thread.xs in core perl (where t is the
  * thread calling new_struct_thread) clearly satisfies this constraint.
  */
+
 struct perl_thread *
 Perl_new_struct_thread(pTHX_ struct perl_thread *t)
 {
@@ -3358,6 +3359,7 @@
     SV *sv;
     SV **svp;
     I32 i;
+    I32 index;
 
     sv = newSVpvn("", 0);
     SvGROW(sv, sizeof(struct perl_thread) + 1);
@@ -3466,6 +3468,27 @@
     t->next = thr;
     thr->next->prev = thr;
     MUTEX_UNLOCK(&PL_threads_mutex);
+
+    /* Allocate space for this thread's match variables set. */
+
+    Newz (0, PL_matchvars, number_of_regexps, match_vars_t);
+
+    /* Remeber how big that space is. */
+
+    PL_sizeof_match_vars_array = number_of_regexps;
+
+    /* For each match variable set, allocate space for the set's
+     * parentheses data. */
+
+    for (index = 0; index < number_of_regexps; index++)
+      {
+	New (0,
+	     PL_matchvars[index].startp,
+	     largest_number_of_parentheses_so_far, I32);
+	New (0,
+	     PL_matchvars[index].endp,
+	     largest_number_of_parentheses_so_far, I32);
+      }
 
     /* done copying parent's state */
     MUTEX_UNLOCK(&t->mutex);
--- perl5.005_62-bugged/regexp.h	Sat Sep  4 16:02:01 1999
+++ perl5.005_62/regexp.h	Thu Nov 18 15:23:27 1999
@@ -19,6 +19,37 @@
 
 struct reg_substr_data;
 
+/* Match variables data structure. */
+
+typedef struct match_vars_struct
+  {
+    char *subbeg;
+    I32 *startp;
+    I32 *endp;
+    I32 sublen;
+  }
+match_vars_t;
+
+/* Macro to retrieve the correct match variable set
+ * from the thread structure. This is done with the
+ * regexp's index (id). */
+
+#ifdef USE_THREADS
+#  define get_match_node(regexp) (&(PL_matchvars[regexp->regexp_index]))
+#else
+#  define get_match_node(regexp) (regexp)
+#endif
+
+/* Global variables used for managing match variables.
+ * See their declarations in regcomp.c. */
+
+#ifdef USE_THREADS
+
+extern U32 number_of_regexps;
+extern I32 largest_number_of_parentheses_so_far;
+
+#endif
+
 typedef struct regexp {
 	I32 *startp;
 	I32 *endp;
@@ -36,6 +67,9 @@
 	U32 lastparen;		/* last paren matched */
 	U32 reganch;		/* Internal use only +
 				   Tainted information used by regexec? */
+
+        U32 regexp_index;       /* A unique id for this regexp. */ 
+
 	regnode program[1];	/* Unwarranted chumminess with compiler. */
 } regexp;
 
--- perl5.005_62-bugged/thrdvar.h	Fri Oct  8 06:05:56 1999
+++ perl5.005_62/thrdvar.h	Thu Nov 18 13:35:32 1999
@@ -226,4 +226,7 @@
 
 PERLVAR(trailing_nul,	char)		/* For the sake of thrsv and oursv */
 
+PERLVAR(Tmatchvars,     match_vars_t *);
+PERLVARI(Tsizeof_match_vars_array, I32, 0);
+
 #endif /* USE_THREADS */
--- perl5.005_62-bugged/embedvar.h	Wed Oct 13 20:09:30 1999
+++ perl5.005_62/embedvar.h	Thu Nov 18 13:36:45 1999
@@ -163,6 +163,8 @@
 #define PL_toptarget		(vTHX->Ttoptarget)
 #define PL_watchaddr		(vTHX->Twatchaddr)
 #define PL_watchok		(vTHX->Twatchok)
+#define PL_matchvars            (vTHX->Tmatchvars)
+#define PL_sizeof_match_vars_array (vTHX->Tsizeof_match_vars_array)
 
 #  if defined(PERL_OBJECT)
 #    include "error: PERL_OBJECT + MULTIPLICITY don't go together"
@@ -1137,6 +1139,8 @@
 #define PL_toptarget		(aTHX->Ttoptarget)
 #define PL_watchaddr		(aTHX->Twatchaddr)
 #define PL_watchok		(aTHX->Twatchok)
+#define PL_matchvars		(aTHX->Tmatchvars)
+#define PL_sizeof_match_vars_array (aTHX->Tsizeof_match_vars_array)
 
 #  else		/* !USE_THREADS */
 /* cases 1 and 6 above */
--- perl5.005_62-bugged/ext/Thread/Thread.xs	Mon Oct 11 15:34:47 1999
+++ perl5.005_62/ext/Thread/Thread.xs	Fri Nov 19 13:16:24 1999
@@ -23,6 +23,8 @@
 static void
 remove_thread(pTHX_ struct perl_thread *t)
 {
+    int index;
+
 #ifdef USE_THREADS
     DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
 				   "%p: remove_thread %p\n", thr, t)));
@@ -34,7 +36,26 @@
     SvREFCNT_dec(t->oursv);
     COND_BROADCAST(&PL_nthreads_cond);
     MUTEX_UNLOCK(&PL_threads_mutex);
+
+    /* Free space allocated for match variables. */
+
+    if (t->Tsizeof_match_vars_array != 0)
+      {
+	if (t->Tmatchvars != NULL)
+	  {	
+	    for (index = 0; index < t->Tsizeof_match_vars_array; index++)
+	      {
+		if (t->Tmatchvars[index].startp != NULL)
+		  Safefree (t->Tmatchvars[index].startp);
+		if (t->Tmatchvars[index].endp != NULL)
+		  Safefree (t->Tmatchvars[index].endp);
+	      }
+	    Safefree (t->Tmatchvars);
+	  }
+      }
+
 #endif
+
 }
 
 static THREAD_RET_TYPE

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About