On Linux, don't compile with -DTHREADS_HAVE_PIDS if the
[p5sagit/p5-mst-13.2.git] / regcomp.c
index 9733476..c58a784 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4695,8 +4695,8 @@ reStudy:
             ARG2L_SET( scan, RExC_open_parens[ARG(scan)-1] - scan );
         }
     }
-    Newxz(r->startp, RExC_npar, I32);
-    Newxz(r->endp, RExC_npar, I32);
+    Newxz(r->startp, RExC_npar * 2, I32);
+    r->endp = r->startp + RExC_npar;
     /* assume we don't need to swap parens around before we match */
 
     DEBUG_DUMP_r({
@@ -4954,10 +4954,6 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) {
 #define REGTAIL_STUDY(x,y,z) regtail((x),(y),(z),depth+1)
 #endif
 
-/* this idea is borrowed from STR_WITH_LEN in handy.h */
-#define CHECK_WORD(s,v,l)  \
-    (((sizeof(s)-1)==(l)) && (memEQ(start_verb, (s ""), (sizeof(s)-1))))
-
 STATIC regnode *
 S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
@@ -5026,39 +5022,39 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
            
            switch ( *start_verb ) {
             case 'A':  /* (*ACCEPT) */
-                if ( CHECK_WORD("ACCEPT",start_verb,verb_len) ) {
+                if ( memEQs(start_verb,verb_len,"ACCEPT") ) {
                    op = ACCEPT;
                    internal_argval = RExC_nestroot;
                }
                break;
             case 'C':  /* (*COMMIT) */
-                if ( CHECK_WORD("COMMIT",start_verb,verb_len) )
+                if ( memEQs(start_verb,verb_len,"COMMIT") )
                     op = COMMIT;
                 break;
             case 'F':  /* (*FAIL) */
-                if ( verb_len==1 || CHECK_WORD("FAIL",start_verb,verb_len) ) {
+                if ( verb_len==1 || memEQs(start_verb,verb_len,"FAIL") ) {
                    op = OPFAIL;
                    argok = 0;
                }
                break;
             case ':':  /* (*:NAME) */
            case 'M':  /* (*MARK:NAME) */
-               if ( verb_len==0 || CHECK_WORD("MARK",start_verb,verb_len) ) {
+               if ( verb_len==0 || memEQs(start_verb,verb_len,"MARK") ) {
                     op = MARKPOINT;
                     argok = -1;
                 }
                 break;
             case 'P':  /* (*PRUNE) */
-                if ( CHECK_WORD("PRUNE",start_verb,verb_len) )
+                if ( memEQs(start_verb,verb_len,"PRUNE") )
                     op = PRUNE;
                 break;
             case 'S':   /* (*SKIP) */  
-                if ( CHECK_WORD("SKIP",start_verb,verb_len) ) 
+                if ( memEQs(start_verb,verb_len,"SKIP") ) 
                     op = SKIP;
                 break;
             case 'T':  /* (*THEN) */
                 /* [19:06] <TimToady> :: is then */
-                if ( CHECK_WORD("THEN",start_verb,verb_len) ) {
+                if ( memEQs(start_verb,verb_len,"THEN") ) {
                     op = CUTGROUP;
                     RExC_seen |= REG_SEEN_CUTGROUP;
                 }
@@ -8692,11 +8688,9 @@ Perl_pregfree(pTHX_ struct regexp *r)
 #endif
     if (r->swap) {
         Safefree(r->swap->startp);
-        Safefree(r->swap->endp);
         Safefree(r->swap);
     }
     Safefree(r->startp);
-    Safefree(r->endp);
     Safefree(r);
 }
 
@@ -8724,23 +8718,22 @@ Perl_reg_temp_copy (pTHX_ struct regexp *r) {
     (void)ReREFCNT_inc(r);
     Newx(ret, 1, regexp);
     StructCopy(r, ret, regexp);
-    Newx(ret->startp, npar, I32);
-    Copy(r->startp, ret->startp, npar, I32);
-    Newx(ret->endp, npar, I32);
-    Copy(r->endp, ret->endp, npar, I32);
+    Newx(ret->startp, npar * 2, I32);
+    Copy(r->startp, ret->startp, npar * 2, I32);
+    ret->endp = ret->startp + npar;
     ret->refcnt = 1;
     if (r->substrs) {
-        struct reg_substr_datum *s;
-        I32 i;
         Newx(ret->substrs, 1, struct reg_substr_data);
-        for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
-            s->min_offset = r->substrs->data[i].min_offset;
-            s->max_offset = r->substrs->data[i].max_offset;
-            s->end_shift  = r->substrs->data[i].end_shift;
-            s->substr     = SvREFCNT_inc(r->substrs->data[i].substr);
-            s->utf8_substr = SvREFCNT_inc(r->substrs->data[i].utf8_substr);
-        }
-    }        
+       StructCopy(r->substrs, ret->substrs, struct reg_substr_data);
+
+       SvREFCNT_inc_void(ret->anchored_substr);
+       SvREFCNT_inc_void(ret->anchored_utf8);
+       SvREFCNT_inc_void(ret->float_substr);
+       SvREFCNT_inc_void(ret->float_utf8);
+
+       /* check_substr and check_utf8, if non-NULL, point to either their
+          anchored or float namesakes, and don't hold a second reference.  */
+    }
     RX_MATCH_COPIED_off(ret);
 #ifdef PERL_OLD_COPY_ON_WRITE
     /* this is broken. */
@@ -8887,12 +8880,11 @@ Perl_regfree_internal(pTHX_ struct regexp *r)
 #define SAVEPVN(p,n)   ((p) ? savepvn(p,n) : NULL)
 
 /* 
-   regdupe - duplicate a regexp. 
-   
-   This routine is called by sv.c's re_dup and is expected to clone a 
-   given regexp structure. It is a no-op when not under USE_ITHREADS. 
-   (Originally this *was* re_dup() for change history see sv.c)
+   re_dup - duplicate a regexp. 
    
+   This routine is expected to clone a given regexp structure. It is not
+   compiler under USE_ITHREADS.
+
    After all of the core data stored in struct regexp is duplicated
    the regexp_engine.dupe method is used to copy any private data
    stored in the *pprivate pointer. This allows extensions to handle
@@ -8907,8 +8899,7 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
 {
     dVAR;
     regexp *ret;
-    I32 i, npar;
-    struct reg_substr_datum *s;
+    I32 npar;
 
     if (!r)
        return (REGEXP *)NULL;
@@ -8918,64 +8909,66 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
 
     
     npar = r->nparens+1;
-    Newxz(ret, 1, regexp);
-    Newx(ret->startp, npar, I32);
-    Copy(r->startp, ret->startp, npar, I32);
-    Newx(ret->endp, npar, I32);
-    Copy(r->endp, ret->endp, npar, I32);
-    if(r->swap) {
+    Newx(ret, 1, regexp);
+    StructCopy(r, ret, regexp);
+    Newx(ret->startp, npar * 2, I32);
+    Copy(r->startp, ret->startp, npar * 2, I32);
+    ret->endp = ret->startp + npar;
+    if(ret->swap) {
         Newx(ret->swap, 1, regexp_paren_ofs);
         /* no need to copy these */
-        Newx(ret->swap->startp, npar, I32);
-        Newx(ret->swap->endp, npar, I32);
-    } else {
-        ret->swap = NULL;
+        Newx(ret->swap->startp, npar * 2, I32);
+       ret->swap->endp = ret->swap->startp + npar;
     }
 
-    if (r->substrs) {
+    if (ret->substrs) {
+       /* Do it this way to avoid reading from *r after the StructCopy().
+          That way, if any of the sv_dup_inc()s dislodge *r from the L1
+          cache, it doesn't matter.  */
+       const bool anchored = r->check_substr == r->anchored_substr;
         Newx(ret->substrs, 1, struct reg_substr_data);
-        for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
-            s->min_offset = r->substrs->data[i].min_offset;
-            s->max_offset = r->substrs->data[i].max_offset;
-            s->end_shift  = r->substrs->data[i].end_shift;
-            s->substr     = sv_dup_inc(r->substrs->data[i].substr, param);
-            s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
-        }
-    } else 
-        ret->substrs = NULL;    
+       StructCopy(r->substrs, ret->substrs, struct reg_substr_data);
 
-    ret->wrapped        = SAVEPVN(r->wrapped, r->wraplen+1);
-    ret->precomp        = ret->wrapped + (r->precomp - r->wrapped);
-    ret->prelen         = r->prelen;
-    ret->wraplen        = r->wraplen;
+       ret->anchored_substr = sv_dup_inc(ret->anchored_substr, param);
+       ret->anchored_utf8 = sv_dup_inc(ret->anchored_utf8, param);
+       ret->float_substr = sv_dup_inc(ret->float_substr, param);
+       ret->float_utf8 = sv_dup_inc(ret->float_utf8, param);
 
-    ret->mother_re      = NULL;
-    ret->refcnt         = r->refcnt;
-    ret->minlen         = r->minlen;
-    ret->minlenret      = r->minlenret;
-    ret->nparens        = r->nparens;
-    ret->lastparen      = r->lastparen;
-    ret->lastcloseparen = r->lastcloseparen;
-    ret->intflags       = r->intflags;
-    ret->extflags       = r->extflags;
-
-    ret->sublen         = r->sublen;
-
-    ret->engine         = r->engine;
-    
-    ret->paren_names    = hv_dup_inc(r->paren_names, param);
+       /* check_substr and check_utf8, if non-NULL, point to either their
+          anchored or float namesakes, and don't hold a second reference.  */
+
+       if (ret->check_substr) {
+           if (anchored) {
+               assert(r->check_utf8 == r->anchored_utf8);
+               ret->check_substr = ret->anchored_substr;
+               ret->check_utf8 = ret->anchored_utf8;
+           } else {
+               assert(r->check_substr == r->float_substr);
+               assert(r->check_utf8 == r->float_utf8);
+               ret->check_substr = ret->float_substr;
+               ret->check_utf8 = ret->float_utf8;
+           }
+       }
+    }
+
+    ret->wrapped        = SAVEPVN(ret->wrapped, ret->wraplen+1);
+    ret->precomp        = ret->wrapped + (ret->precomp - ret->wrapped);
+    ret->paren_names    = hv_dup_inc(ret->paren_names, param);
+
+    if (ret->pprivate)
+       RXi_SET(ret,CALLREGDUPE_PVT(ret,param));
 
     if (RX_MATCH_COPIED(ret))
-       ret->subbeg  = SAVEPVN(r->subbeg, r->sublen);
+       ret->subbeg  = SAVEPVN(ret->subbeg, ret->sublen);
     else
        ret->subbeg = NULL;
 #ifdef PERL_OLD_COPY_ON_WRITE
     ret->saved_copy = NULL;
 #endif
-    
-    ret->pprivate = r->pprivate;
-    if (ret->pprivate) 
-        RXi_SET(ret,CALLREGDUPE_PVT(ret,param));
+
+    ret->mother_re      = NULL;
+    ret->gofs = 0;
+    ret->seen_evals = 0;
     
     ptr_table_store(PL_ptr_table, r, ret);
     return ret;