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
-
Patch for Threading and Regexps
by Brian Mancuso