X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4f55667c12ebe5fc04eddfc4074d7d78730cc30e..d2ece331daee8e28f4c669904c9cfa6dee30dd74:/regexec.c

diff --git a/regexec.c b/regexec.c
index 3c3c01f..9a41f20 100644
--- a/regexec.c
+++ b/regexec.c
@@ -184,25 +184,24 @@ S_regcppush(pTHX_ I32 parenfloor)
     if (paren_elems_to_push < 0)
 	Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 
-#define REGCP_OTHER_ELEMS 8
+#define REGCP_OTHER_ELEMS 7
     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
     
     for (p = PL_regsize; p > parenfloor; p--) {
 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
-	SSPUSHINT(PL_regendp[p]);
-	SSPUSHINT(PL_regstartp[p]);
+	SSPUSHINT(PL_regoffs[p].end);
+	SSPUSHINT(PL_regoffs[p].start);
 	SSPUSHPTR(PL_reg_start_tmp[p]);
 	SSPUSHINT(p);
-	DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
+	DEBUG_BUFFERS_r(PerlIO_printf(Perl_debug_log,
 	  "     saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
-		      (UV)p, (IV)PL_regstartp[p],
+		      (UV)p, (IV)PL_regoffs[p].start,
 		      (IV)(PL_reg_start_tmp[p] - PL_bostr),
-		      (IV)PL_regendp[p]
+		      (IV)PL_regoffs[p].end
 	));
     }
 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
-    SSPUSHPTR(PL_regstartp);
-    SSPUSHPTR(PL_regendp);
+    SSPUSHPTR(PL_regoffs);
     SSPUSHINT(PL_regsize);
     SSPUSHINT(*PL_reglastparen);
     SSPUSHINT(*PL_reglastcloseparen);
@@ -249,8 +248,7 @@ S_regcppop(pTHX_ const regexp *rex)
     *PL_reglastcloseparen = SSPOPINT;
     *PL_reglastparen = SSPOPINT;
     PL_regsize = SSPOPINT;
-    PL_regendp=(I32 *) SSPOPPTR;
-    PL_regstartp=(I32 *) SSPOPPTR;
+    PL_regoffs=(regexp_paren_pair *) SSPOPPTR;
 
     
     /* Now restore the parentheses context. */
@@ -259,20 +257,20 @@ S_regcppop(pTHX_ const regexp *rex)
 	I32 tmps;
 	U32 paren = (U32)SSPOPINT;
 	PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
-	PL_regstartp[paren] = SSPOPINT;
+	PL_regoffs[paren].start = SSPOPINT;
 	tmps = SSPOPINT;
 	if (paren <= *PL_reglastparen)
-	    PL_regendp[paren] = tmps;
-	DEBUG_EXECUTE_r(
+	    PL_regoffs[paren].end = tmps;
+	DEBUG_BUFFERS_r(
 	    PerlIO_printf(Perl_debug_log,
 			  "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
-			  (UV)paren, (IV)PL_regstartp[paren],
+			  (UV)paren, (IV)PL_regoffs[paren].start,
 			  (IV)(PL_reg_start_tmp[paren] - PL_bostr),
-			  (IV)PL_regendp[paren],
+			  (IV)PL_regoffs[paren].end,
 			  (paren > *PL_reglastparen ? "(no)" : ""));
 	);
     }
-    DEBUG_EXECUTE_r(
+    DEBUG_BUFFERS_r(
 	if (*PL_reglastparen + 1 <= rex->nparens) {
 	    PerlIO_printf(Perl_debug_log,
 			  "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
@@ -287,13 +285,12 @@ S_regcppop(pTHX_ const regexp *rex)
      * requiring null fields (pat.t#187 and split.t#{13,14}
      * (as of patchlevel 7877)  will fail.  Then again,
      * this code seems to be necessary or otherwise
-     * building DynaLoader will fail:
-     * "Error: '*' not in typemap in DynaLoader.xs, line 164"
-     * --jhi */
+     * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
+     * --jhi updated by dapm */
     for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
 	if (i > PL_regsize)
-	    PL_regstartp[i] = -1;
-	PL_regendp[i] = -1;
+	    PL_regoffs[i].start = -1;
+	PL_regoffs[i].end = -1;
     }
 #endif
     return input;
@@ -310,7 +307,7 @@ S_regcppop(pTHX_ const regexp *rex)
  - pregexec - match a regexp against a string
  */
 I32
-Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
+Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend,
 	 char *strbeg, I32 minend, SV *screamer, U32 nosave)
 /* strend: pointer to null at end of string */
 /* strbeg: real beginning of string */
@@ -374,10 +371,11 @@ Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *stren
    deleted from the finite automaton. */
 
 char *
-Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
-		     char *strend, U32 flags, re_scream_pos_data *data)
+Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
+		     char *strend, const U32 flags, re_scream_pos_data *data)
 {
     dVAR;
+    struct regexp *const prog = (struct regexp *)SvANY(rx);
     register I32 start_shift = 0;
     /* Should be nonnegative! */
     register I32 end_shift   = 0;
@@ -397,13 +395,13 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
     GET_RE_DEBUG_FLAGS_DECL;
 
-    RX_MATCH_UTF8_set(prog,do_utf8);
+    RX_MATCH_UTF8_set(rx,do_utf8);
 
-    if (prog->extflags & RXf_UTF8) {
+    if (RX_UTF8(rx)) {
 	PL_reg_flags |= RF_utf8;
     }
     DEBUG_EXECUTE_r( 
-        debug_start_match(prog, do_utf8, strpos, strend, 
+        debug_start_match(rx, do_utf8, strpos, strend, 
             sv ? "Guessing start of match in sv for"
                : "Guessing start of match in string for");
 	      );
@@ -504,7 +502,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 #ifdef QDEBUGGING	/* 7/99: reports of failure (with the older version) */
     if (end_shift < 0)
 	Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
-		   (IV)end_shift, prog->precomp);
+		   (IV)end_shift, RX_PRECOMP(prog));
 #endif
 
   restart:
@@ -539,7 +537,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 	else
 	    goto fail_finish;
 	/* we may be pointing at the wrong string */
-	if (s && RX_MATCH_COPIED(prog))
+	if (s && RXp_MATCH_COPIED(prog))
 	    s = strbeg + (s - SvPVX_const(sv));
 	if (data)
 	    *data->scream_olds = s;
@@ -992,7 +990,11 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     return NULL;
 }
 
-
+#define DECL_TRIE_TYPE(scan) \
+    const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold } \
+		    trie_type = (scan->flags != EXACT) \
+		              ? (do_utf8 ? trie_utf8_fold : (UTF ? trie_latin_utf8_fold : trie_plain)) \
+                              : (do_utf8 ? trie_utf8 : trie_plain)
 
 #define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len,  \
 uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
@@ -1010,6 +1012,19 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
 	    uscan = foldbuf + UNISKIP( uvc );                               \
 	}                                                                   \
 	break;                                                              \
+    case trie_latin_utf8_fold:                                              \
+	if ( foldlen>0 ) {                                                  \
+	    uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );     \
+	    foldlen -= len;                                                 \
+	    uscan += len;                                                   \
+	    len=0;                                                          \
+	} else {                                                            \
+	    len = 1;                                                        \
+	    uvc = to_uni_fold( *(U8*)uc, foldbuf, &foldlen );               \
+	    foldlen -= UNISKIP( uvc );                                      \
+	    uscan = foldbuf + UNISKIP( uvc );                               \
+	}                                                                   \
+	break;                                                              \
     case trie_utf8:                                                         \
 	uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );       \
 	break;                                                              \
@@ -1032,12 +1047,14 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
     }                                                                       \
 } STMT_END
 
-#define REXEC_FBC_EXACTISH_CHECK(CoNd)                  \
+#define REXEC_FBC_EXACTISH_CHECK(CoNd)                 \
+{                                                      \
+    char *my_strend= (char *)strend;                   \
     if ( (CoNd)                                        \
 	 && (ln == len ||                              \
-	     ibcmp_utf8(s, NULL, 0,  do_utf8,          \
+	     !ibcmp_utf8(s, &my_strend, 0,  do_utf8,   \
 			m, NULL, ln, (bool)UTF))       \
-	 && (!reginfo || regtry(reginfo, &s)) )         \
+	 && (!reginfo || regtry(reginfo, &s)) )        \
 	goto got_it;                                   \
     else {                                             \
 	 U8 foldbuf[UTF8_MAXBYTES_CASE+1];             \
@@ -1045,15 +1062,14 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
 	 f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);  \
 	 if ( f != c                                   \
 	      && (f == c1 || f == c2)                  \
-	      && (ln == foldlen ||                     \
-		  !ibcmp_utf8((char *) foldbuf,        \
-			      NULL, foldlen, do_utf8,  \
-			      m,                       \
-			      NULL, ln, (bool)UTF))    \
-	      && (!reginfo || regtry(reginfo, &s)) )    \
+	      && (ln == len ||                         \
+	        !ibcmp_utf8(s, &my_strend, 0,  do_utf8,\
+			      m, NULL, ln, (bool)UTF)) \
+	      && (!reginfo || regtry(reginfo, &s)) )   \
 	      goto got_it;                             \
     }                                                  \
-    s += len
+}                                                      \
+s += len
 
 #define REXEC_FBC_EXACTISH_SCAN(CoNd)                     \
 STMT_START {                                              \
@@ -1112,6 +1128,15 @@ REXEC_FBC_SCAN(                                       \
 if ((!reginfo || regtry(reginfo, &s))) \
     goto got_it
 
+#define REXEC_FBC_CSCAN(CoNdUtF8,CoNd)                         \
+    if (do_utf8) {                                             \
+	REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8);                   \
+    }                                                          \
+    else {                                                     \
+	REXEC_FBC_CLASS_SCAN(CoNd);                            \
+    }                                                          \
+    break
+    
 #define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd)      \
     if (do_utf8) {                                             \
 	UtFpReLoAd;                                            \
@@ -1203,15 +1228,28 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 		U8 *sm = (U8 *) m;
 		U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
 		U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
-		const U32 uniflags = UTF8_ALLOW_DEFAULT;
-
-		to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
-		to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
-
+		/* used by commented-out code below */
+		/*const U32 uniflags = UTF8_ALLOW_DEFAULT;*/
+		
+                /* XXX: Since the node will be case folded at compile
+                   time this logic is a little odd, although im not 
+                   sure that its actually wrong. --dmq */
+                   
+		c1 = to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
+		c2 = to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
+
+		/* XXX: This is kinda strange. to_utf8_XYZ returns the 
+                   codepoint of the first character in the converted
+                   form, yet originally we did the extra step. 
+                   No tests fail by commenting this code out however
+                   so Ive left it out. -- dmq.
+                   
 		c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, 
 				    0, uniflags);
 		c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
 				    0, uniflags);
+                */
+                
 		lnc = 0;
 		while (sm < ((U8 *) m + ln)) {
 		    lnc++;
@@ -1246,24 +1284,33 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 	     * matching (called "loose matching" in Unicode).
 	     * ibcmp_utf8() will do just that. */
 
-	    if (do_utf8) {
+	    if (do_utf8 || UTF) {
 	        UV c, f;
 	        U8 tmpbuf [UTF8_MAXBYTES+1];
-		STRLEN len, foldlen;
+		STRLEN len = 1;
+		STRLEN foldlen;
 		const U32 uniflags = UTF8_ALLOW_DEFAULT;
 		if (c1 == c2) {
 		    /* Upper and lower of 1st char are equal -
 		     * probably not a "letter". */
 		    while (s <= e) {
-		        c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
+		        if (do_utf8) {
+		            c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
 					   uniflags);
+                        } else {
+                            c = *((U8*)s);
+                        }					  
 			REXEC_FBC_EXACTISH_CHECK(c == c1);
 		    }
 		}
 		else {
 		    while (s <= e) {
-		      c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
+		        if (do_utf8) {
+		            c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
 					   uniflags);
+                        } else {
+                            c = *((U8*)s);
+                        }
 
 			/* Handle some of the three Greek sigmas cases.
 			 * Note that not all the possible combinations
@@ -1281,6 +1328,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 		}
 	    }
 	    else {
+	        /* Neither pattern nor string are UTF8 */
 		if (c1 == c2)
 		    REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
 		else
@@ -1427,13 +1475,35 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 		!isDIGIT_LC_utf8((U8*)s),
 		!isDIGIT_LC(*s)
 	    );
+	case LNBREAK:
+	    REXEC_FBC_CSCAN(
+		is_LNBREAK_utf8(s),
+		is_LNBREAK_latin1(s)
+	    );
+	case VERTWS:
+	    REXEC_FBC_CSCAN(
+		is_VERTWS_utf8(s),
+		is_VERTWS_latin1(s)
+	    );
+	case NVERTWS:
+	    REXEC_FBC_CSCAN(
+		!is_VERTWS_utf8(s),
+		!is_VERTWS_latin1(s)
+	    );
+	case HORIZWS:
+	    REXEC_FBC_CSCAN(
+		is_HORIZWS_utf8(s),
+		is_HORIZWS_latin1(s)
+	    );
+	case NHORIZWS:
+	    REXEC_FBC_CSCAN(
+		!is_HORIZWS_utf8(s),
+		!is_HORIZWS_latin1(s)
+	    );	    
 	case AHOCORASICKC:
 	case AHOCORASICK: 
 	    {
-	        const enum { trie_plain, trie_utf8, trie_utf8_fold }
-		    trie_type = do_utf8 ?
-			  (c->flags == EXACT ? trie_utf8 : trie_utf8_fold)
-			: trie_plain;
+	        DECL_TRIE_TYPE(c);
                 /* what trie are we using right now */
         	reg_ac_data *aho
         	    = (reg_ac_data*)progi->data->data[ ARG( c ) ];
@@ -1450,8 +1520,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 		U8 **points; /* map of where we were in the input string
 		                when reading a given char. For ASCII this
 		                is unnecessary overhead as the relationship
-		                is always 1:1, but for unicode, especially
-		                case folded unicode this is not true. */
+		                is always 1:1, but for Unicode, especially
+		                case folded Unicode this is not true. */
 		U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
 		U8 *bitmap=NULL;
 
@@ -1651,10 +1721,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 
 static void 
 S_swap_match_buff (pTHX_ regexp *prog) {
-    I32 *t;
-    RXi_GET_DECL(prog,progi);
+    regexp_paren_pair *t;
 
-    if (!progi->swap) {
+    if (!prog->swap) {
     /* We have to be careful. If the previous successful match
        was from this regex we don't want a subsequent paritally
        successful match to clobber the old results. 
@@ -1662,17 +1731,11 @@ S_swap_match_buff (pTHX_ regexp *prog) {
        to the re, and switch the buffer each match. If we fail
        we switch it back, otherwise we leave it swapped.
     */
-        Newxz(progi->swap, 1, regexp_paren_ofs);
-        /* no need to copy these */
-        Newxz(progi->swap->startp, prog->nparens + 1, I32);
-        Newxz(progi->swap->endp, prog->nparens + 1, I32);
+        Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
     }
-    t = progi->swap->startp;
-    progi->swap->startp = prog->startp;
-    prog->startp = t;
-    t = progi->swap->endp;
-    progi->swap->endp = prog->endp;
-    prog->endp = t;
+    t = prog->swap;
+    prog->swap = prog->offs;
+    prog->offs = t;
 }    
 
 
@@ -1680,7 +1743,7 @@ S_swap_match_buff (pTHX_ regexp *prog) {
  - regexec_flags - match a regexp against a string
  */
 I32
-Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
+Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend,
 	      char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
 /* strend: pointer to null at end of string */
 /* strbeg: real beginning of string */
@@ -1691,6 +1754,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 /* nosave: For optimizations. */
 {
     dVAR;
+    struct regexp *const prog = (struct regexp *)SvANY(rx);
     /*register*/ char *s;
     register regnode *c;
     /*register*/ char *startpos = stringarg;
@@ -1699,7 +1763,6 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     I32 end_shift = 0;			/* Same for the end. */		/* CC */
     I32 scream_pos = -1;		/* Internal iterator of scream. */
     char *scream_olds = NULL;
-    SV* const oreplsv = GvSV(PL_replgv);
     const bool do_utf8 = (bool)DO_UTF8(sv);
     I32 multiline;
     RXi_GET_DECL(prog,progi);
@@ -1717,11 +1780,11 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     }
 
     multiline = prog->extflags & RXf_PMf_MULTILINE;
-    reginfo.prog = prog;
+    reginfo.prog = rx;	 /* Yes, sorry that this is confusing.  */
 
-    RX_MATCH_UTF8_set(prog, do_utf8);
+    RX_MATCH_UTF8_set(rx, do_utf8);
     DEBUG_EXECUTE_r( 
-        debug_start_match(prog, do_utf8, startpos, strend, 
+        debug_start_match(rx, do_utf8, startpos, strend, 
         "Matching");
     );
 
@@ -1743,7 +1806,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     PL_reg_eval_set = 0;
     PL_reg_maxiter = 0;
 
-    if (prog->extflags & RXf_UTF8)
+    if (RX_UTF8(rx))
 	PL_reg_flags |= RF_utf8;
 
     /* Mark beginning of line for ^ and lookbehind. */
@@ -1781,7 +1844,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 	} else				/* pos() not defined */
 	    reginfo.ganch = strbeg;
     }
-    if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
+    if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) {
         swap_on_fail = 1;
         swap_match_buff(prog); /* do we need a save destructor here for
                                   eval dies? */
@@ -1791,7 +1854,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 
 	d.scream_olds = &scream_olds;
 	d.scream_pos = &scream_pos;
-	s = re_intuit_start(prog, sv, s, strend, flags, &d);
+	s = re_intuit_start(rx, sv, s, strend, flags, &d);
 	if (!s) {
 	    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
 	    goto phooey;	/* not present */
@@ -1821,10 +1884,10 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 		    if (regtry(&reginfo, &s))
 			goto got_it;
 		  after_try:
-		    if (s >= end)
+		    if (s > end)
 			goto phooey;
 		    if (prog->extflags & RXf_USE_INTUIT) {
-			s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
+			s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL);
 			if (!s)
 			    goto phooey;
 		    }
@@ -1948,7 +2011,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 				  (unsigned char*)strend, must,
 				  multiline ? FBMrf_MULTILINE : 0))) ) {
 	    /* we may be pointing at the wrong string */
-	    if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
+	    if ((flags & REXEC_SCREAM) && RXp_MATCH_COPIED(prog))
 		s = strbeg + (s - SvPVX_const(sv));
 	    DEBUG_EXECUTE_r( did_match = 1 );
 	    if (HOPc(s, -back_max) > last1) {
@@ -1997,7 +2060,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 	    SV * const prop = sv_newmortal();
 	    regprop(prog, prop, c);
 	    {
-		RE_PV_QUOTED_DECL(quoted,UTF,PERL_DEBUG_PAD_ZERO(1),
+		RE_PV_QUOTED_DECL(quoted,do_utf8,PERL_DEBUG_PAD_ZERO(1),
 		    s,strend-s,60);
 		PerlIO_printf(Perl_debug_log,
 		    "Matching stclass %.*s against %s (%d chars)\n",
@@ -2026,7 +2089,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 		if (!last)
 		    last = scream_olds; /* Only one occurrence. */
 		/* we may be pointing at the wrong string */
-		else if (RX_MATCH_COPIED(prog))
+		else if (RXp_MATCH_COPIED(prog))
 		    s = strbeg + (s - SvPVX_const(sv));
 	    }
 	    else {
@@ -2083,22 +2146,16 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     goto phooey;
 
 got_it:
-    RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
+    RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted);
 
-    if (PL_reg_eval_set) {
-	/* Preserve the current value of $^R */
-	if (oreplsv != GvSV(PL_replgv))
-	    sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
-						  restored, the value remains
-						  the same. */
+    if (PL_reg_eval_set)
 	restore_pos(aTHX_ prog);
-    }
-    if (prog->paren_names) 
-        (void)hv_iterinit(prog->paren_names);
+    if (RXp_PAREN_NAMES(prog)) 
+        (void)hv_iterinit(RXp_PAREN_NAMES(prog));
 
     /* make sure $`, $&, $', and $digit will work later */
     if ( !(flags & REXEC_NOT_FIRST) ) {
-	RX_MATCH_COPY_FREE(prog);
+	RX_MATCH_COPY_FREE(rx);
 	if (flags & REXEC_COPY_STR) {
 	    const I32 i = PL_regeol - startpos + (stringarg - strbeg);
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -2115,7 +2172,7 @@ got_it:
 	    } else
 #endif
 	    {
-		RX_MATCH_COPIED_on(prog);
+		RX_MATCH_COPIED_on(rx);
 		s = savepvn(strbeg, i);
 		prog->subbeg = s;
 	    }
@@ -2149,10 +2206,9 @@ STATIC I32			/* 0 failure, 1 success */
 S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 {
     dVAR;
-    register I32 *sp;
-    register I32 *ep;
     CHECKPOINT lastcp;
-    regexp *prog = reginfo->prog;
+    REGEXP *const rx = reginfo->prog;
+    regexp *const prog = (struct regexp *)SvANY(rx);
     RXi_GET_DECL(prog,progi);
     GET_RE_DEBUG_FLAGS_DECL;
     reginfo->cutpoint=NULL;
@@ -2200,18 +2256,19 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 #ifdef USE_ITHREADS
             {
 		SV* const repointer = newSViv(0);
-                /* so we know which PL_regex_padav element is PL_reg_curpm */
+                /* so we know which PL_regex_padav element is PL_reg_curpm
+		   when clearing up in perl_destruct() */
                 SvFLAGS(repointer) |= SVf_BREAK;
-                av_push(PL_regex_padav,repointer);
+                av_push(PL_regex_padav, repointer);
                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
                 PL_regex_pad = AvARRAY(PL_regex_padav);
             }
 #endif      
         }
-	PM_SETRE(PL_reg_curpm, prog);
+	PM_SETRE(PL_reg_curpm, rx);
 	PL_reg_oldcurpm = PL_curpm;
 	PL_curpm = PL_reg_curpm;
-	if (RX_MATCH_COPIED(prog)) {
+	if (RXp_MATCH_COPIED(prog)) {
 	    /*  Here is a serious problem: we cannot rewrite subbeg,
 		since it may be needed if this match fails.  Thus
 		$` inside (?{}) could fail... */
@@ -2220,7 +2277,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 #ifdef PERL_OLD_COPY_ON_WRITE
 	    PL_nrs = prog->saved_copy;
 #endif
-	    RX_MATCH_COPIED_off(prog);
+	    RXp_MATCH_COPIED_off(prog);
 	}
 	else
 	    PL_reg_oldsaved = NULL;
@@ -2228,15 +2285,14 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 	prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
     }
     DEBUG_EXECUTE_r(PL_reg_starttry = *startpos);
-    prog->startp[0] = *startpos - PL_bostr;
+    prog->offs[0].start = *startpos - PL_bostr;
     PL_reginput = *startpos;
     PL_reglastparen = &prog->lastparen;
     PL_reglastcloseparen = &prog->lastcloseparen;
     prog->lastparen = 0;
     prog->lastcloseparen = 0;
     PL_regsize = 0;
-    PL_regstartp = prog->startp;
-    PL_regendp = prog->endp;
+    PL_regoffs = prog->offs;
     if (PL_reg_start_tmpl <= prog->nparens) {
 	PL_reg_start_tmpl = prog->nparens*3/2 + 3;
         if(PL_reg_start_tmp)
@@ -2252,27 +2308,26 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
      * Actually, the code in regcppop() (which Ilya may be meaning by
      * PL_reglastparen), is not needed at all by the test suite
-     * (op/regexp, op/pat, op/split), but that code is needed, oddly
-     * enough, for building DynaLoader, or otherwise this
-     * "Error: '*' not in typemap in DynaLoader.xs, line 164"
-     * will happen.  Meanwhile, this code *is* needed for the
+     * (op/regexp, op/pat, op/split), but that code is needed otherwise
+     * this erroneously leaves $1 defined: "1" =~ /^(?:(\d)x)?\d$/
+     * Meanwhile, this code *is* needed for the
      * above-mentioned test suite tests to succeed.  The common theme
      * on those tests seems to be returning null fields from matches.
-     * --jhi */
+     * --jhi updated by dapm */
 #if 1
-    sp = PL_regstartp;
-    ep = PL_regendp;
     if (prog->nparens) {
+	regexp_paren_pair *pp = PL_regoffs;
 	register I32 i;
 	for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
-	    *++sp = -1;
-	    *++ep = -1;
+	    ++pp;
+	    pp->start = -1;
+	    pp->end = -1;
 	}
     }
 #endif
     REGCP_SET(lastcp);
     if (regmatch(reginfo, progi->program + 1)) {
-	PL_regendp[0] = PL_reginput - PL_bostr;
+	PL_regoffs[0].end = PL_reginput - PL_bostr;
 	return 1;
     }
     if (reginfo->cutpoint)
@@ -2314,7 +2369,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 STATIC regmatch_state *
 S_push_slab(pTHX)
 {
-#if PERL_VERSION < 9
+#if PERL_VERSION < 9 && !defined(PERL_CORE)
     dMY_CXT;
 #endif
     regmatch_slab *s = PL_regmatch_slab->next;
@@ -2485,7 +2540,7 @@ regmatch(), slabs allocated since entry are freed.
 	PerlIO_printf(Perl_debug_log,			    \
 	    "    %*s"pp" %s%s%s%s%s\n",			    \
 	    depth*2, "",				    \
-	    reg_name[st->resume_state],                     \
+	    PL_reg_name[st->resume_state],                     \
 	    ((st==yes_state||st==mark_state) ? "[" : ""),   \
 	    ((st==yes_state) ? "Y" : ""),                   \
 	    ((st==mark_state) ? "M" : ""),                  \
@@ -2499,15 +2554,15 @@ regmatch(), slabs allocated since entry are freed.
 #ifdef DEBUGGING
 
 STATIC void
-S_debug_start_match(pTHX_ const regexp *prog, const bool do_utf8, 
+S_debug_start_match(pTHX_ const REGEXP *prog, const bool do_utf8, 
     const char *start, const char *end, const char *blurb)
 {
-    const bool utf8_pat= prog->extflags & RXf_UTF8 ? 1 : 0;
+    const bool utf8_pat = RX_UTF8(prog) ? 1 : 0;
     if (!PL_colorset)   
             reginitcolors();    
     {
         RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), 
-            prog->precomp, prog->prelen, 60);   
+            RX_PRECOMP(prog), RX_PRELEN(prog), 60);   
         
         RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1), 
             start, end - start, 60); 
@@ -2603,7 +2658,7 @@ S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) {
     I32 *nums=(I32*)SvPVX(sv_dat);
     for ( n=0; n<SvIVX(sv_dat); n++ ) {
         if ((I32)*PL_reglastparen >= nums[n] &&
-            PL_regendp[nums[n]] != -1)
+            PL_regoffs[nums[n]].end != -1)
         {
             return nums[n];
         }
@@ -2611,21 +2666,45 @@ S_reg_check_named_buff_matched(pTHX_ const regexp *rex, const regnode *scan) {
     return 0;
 }
 
+
+/* free all slabs above current one  - called during LEAVE_SCOPE */
+
+STATIC void
+S_clear_backtrack_stack(pTHX_ void *p)
+{
+    regmatch_slab *s = PL_regmatch_slab->next;
+    PERL_UNUSED_ARG(p);
+
+    if (!s)
+	return;
+    PL_regmatch_slab->next = NULL;
+    while (s) {
+	regmatch_slab * const osl = s;
+	s = s->next;
+	Safefree(osl);
+    }
+}
+
+
+#define SETREX(Re1,Re2) \
+    if (PL_reg_eval_set) PM_SETRE((PL_reg_curpm), (Re2)); \
+    Re1 = (Re2)
+
 STATIC I32			/* 0 failure, 1 success */
 S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 {
-#if PERL_VERSION < 9
+#if PERL_VERSION < 9 && !defined(PERL_CORE)
     dMY_CXT;
 #endif
     dVAR;
     register const bool do_utf8 = PL_reg_match_utf8;
     const U32 uniflags = UTF8_ALLOW_DEFAULT;
 
-    regexp *rex = reginfo->prog;
+    REGEXP *rex_sv = reginfo->prog;
+    regexp *rex = (struct regexp *)SvANY(rex_sv);
     RXi_GET_DECL(rex,rexi);
     
-    regmatch_slab  *orig_slab;
-    regmatch_state *orig_state;
+    I32	oldsave;
 
     /* the current state. This is a cached copy of PL_regmatch_state */
     register regmatch_state *st;
@@ -2640,7 +2719,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 
     bool result = 0;	    /* return value of S_regmatch */
     int depth = 0;	    /* depth of backtrack stack */
-    int nochange_depth = 0; /* depth of GOSUB recursion with nochange*/
+    U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
+    const U32 max_nochange_depth =
+        (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
+        3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH;
+            
     regmatch_state *yes_state = NULL; /* state to pop to on success of
 							    subpattern */
     /* mark_state piggy backs on the yes_state logic so that when we unwind 
@@ -2659,6 +2742,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                                during a successfull match */
     U32 lastopen = 0;       /* last open we saw */
     bool has_cutgroup = RX_HAS_CUTGROUP(rex) ? 1 : 0;   
+
+    SV* const oreplsv = GvSV(PL_replgv);
                
     
     /* these three flags are set by various ops to signal information to
@@ -2680,9 +2765,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
     GET_RE_DEBUG_FLAGS_DECL;
 #endif
 
-    DEBUG_OPTIMISE_r( {    
+    DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
 	    PerlIO_printf(Perl_debug_log,"regmatch start\n");
-    });
+    }));
     /* on first ever call to regmatch, allocate first slab */
     if (!PL_regmatch_slab) {
 	Newx(PL_regmatch_slab, 1, regmatch_slab);
@@ -2691,10 +2776,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	PL_regmatch_state = SLAB_FIRST(PL_regmatch_slab);
     }
 
-    /* remember current high-water mark for exit */
-    /* XXX this should be done with SAVE* instead */
-    orig_slab  = PL_regmatch_slab;
-    orig_state = PL_regmatch_state;
+    oldsave = PL_savestack_ix;
+    SAVEDESTRUCTOR_X(S_clear_backtrack_stack, NULL);
+    SAVEVPTR(PL_regmatch_slab);
+    SAVEVPTR(PL_regmatch_state);
 
     /* grab next free state slot */
     st = ++PL_regmatch_state;
@@ -2752,14 +2837,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 
 	case KEEPS:
 	    /* update the startpoint */
-	    st->u.keeper.val = PL_regstartp[0];
+	    st->u.keeper.val = PL_regoffs[0].start;
 	    PL_reginput = locinput;
-	    PL_regstartp[0] = locinput - PL_bostr;
+	    PL_regoffs[0].start = locinput - PL_bostr;
 	    PUSH_STATE_GOTO(KEEPS_next, next);
 	    /*NOT-REACHED*/
 	case KEEPS_next_fail:
 	    /* rollback the start point change */
-	    PL_regstartp[0] = st->u.keeper.val;
+	    PL_regoffs[0].start = st->u.keeper.val;
 	    sayNO_SILENT;
 	    /*NOT-REACHED*/
 	case EOL:
@@ -2830,10 +2915,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	case TRIE:
 	    {
                 /* what type of TRIE am I? (utf8 makes this contextual) */
-	        const enum { trie_plain, trie_utf8, trie_utf8_fold }
-		    trie_type = do_utf8 ?
-			  (scan->flags == EXACT ? trie_utf8 : trie_utf8_fold)
-			: trie_plain;
+                DECL_TRIE_TYPE(scan);
 
                 /* what trie are we using right now */
 		reg_trie_data * const trie
@@ -2895,7 +2977,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    if ( got_wordnum ) {
 			if ( ! ST.accepted ) {
 			    ENTER;
-			    SAVETMPS;
+			    /* SAVETMPS; */ /* XXX is this necessary? dmq */
 			    bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
 			    sv_accept_buff=newSV(bufflen *
 					    sizeof(reg_trie_accepted) - 1);
@@ -2978,7 +3060,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             if ( ST.jump) {
                 REGCP_UNWIND(ST.cp);
 	        for (n = *PL_reglastparen; n > ST.lastparen; n--)
-		    PL_regendp[n] = -1;
+		    PL_regoffs[n].end = -1;
 	        *PL_reglastparen = n;
 	    }
           trie_first_try:
@@ -3106,18 +3188,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		PL_reginput = (char *)ST.accept_buff[ best ].endpos;
 		if ( !ST.jump || !ST.jump[ST.accept_buff[best].wordnum]) {
 		    scan = ST.B;
-		    /* NOTREACHED */
 		} else {
 		    scan = ST.me + ST.jump[ST.accept_buff[best].wordnum];
-		    /* NOTREACHED */
-                }
-                if (has_cutgroup) {
-                    PUSH_YES_STATE_GOTO(TRIE_next, scan);    
-                    /* NOTREACHED */
-                } else {
-                    PUSH_STATE_GOTO(TRIE_next, scan);
-                    /* NOTREACHED */
                 }
+                PUSH_YES_STATE_GOTO(TRIE_next, scan);    
                 /* NOTREACHED */
 	    }
 	    /* NOTREACHED */
@@ -3197,8 +3271,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		      * pack("U0U*", 0xDF) =~ /ss/i,
 		      * the 0xC3 0x9F are the UTF-8
 		      * byte sequence for the U+00DF. */
+
 		     if (!(do_utf8 &&
-			   toLOWER(s[0]) == 's' &&
+		           toLOWER(s[0]) == 's' &&
 			   ln >= 2 &&
 			   toLOWER(s[1]) == 's' &&
 			   (U8)l[0] == 0xC3 &&
@@ -3493,17 +3568,17 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    n = ARG(scan);  /* which paren pair */
 	    type = OP(scan);
 	  do_ref:  
-	    ln = PL_regstartp[n];
+	    ln = PL_regoffs[n].start;
 	    PL_reg_leftiter = PL_reg_maxiter;		/* Void cache */
 	    if (*PL_reglastparen < n || ln == -1)
 		sayNO;			/* Do not match unless seen CLOSEn. */
-	    if (ln == PL_regendp[n])
+	    if (ln == PL_regoffs[n].end)
 		break;
 
 	    s = PL_bostr + ln;
 	    if (do_utf8 && type != REF) {	/* REF can do byte comparison */
 		char *l = locinput;
-		const char *e = PL_bostr + PL_regendp[n];
+		const char *e = PL_bostr + PL_regoffs[n].end;
 		/*
 		 * Note that we can't do the "other character" lookup trick as
 		 * in the 8-bit case (no pun intended) because in Unicode we
@@ -3536,7 +3611,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		 (UCHARAT(s) != (type == REFF
 				  ? PL_fold : PL_fold_locale)[nextchr])))
 		sayNO;
-	    ln = PL_regendp[n] - ln;
+	    ln = PL_regoffs[n].end - ln;
 	    if (locinput + ln > PL_regeol)
 		sayNO;
 	    if (ln > 1 && (type == REF
@@ -3559,25 +3634,27 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 #define ST st->u.eval
 	{
 	    SV *ret;
+	    REGEXP *re_sv;
             regexp *re;
             regexp_internal *rei;
             regnode *startpoint;
 
 	case GOSTART:
-	case GOSUB: /*    /(...(?1))/      */
-            if (cur_eval && cur_eval->locinput==locinput) {
+	case GOSUB: /*    /(...(?1))/   /(...(?&foo))/   */
+	    if (cur_eval && cur_eval->locinput==locinput) {
                 if (cur_eval->u.eval.close_paren == (U32)ARG(scan)) 
                     Perl_croak(aTHX_ "Infinite recursion in regex");
-                if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH ) 
+                if ( ++nochange_depth > max_nochange_depth )
                     Perl_croak(aTHX_ 
                         "Pattern subroutine nesting without pos change"
                         " exceeded limit in regex");
             } else {
                 nochange_depth = 0;
             }
+	    re_sv = rex_sv;
             re = rex;
             rei = rexi;
-            (void)ReREFCNT_inc(rex);
+            (void)ReREFCNT_inc(rex_sv);
             if (OP(scan)==GOSUB) {
                 startpoint = scan + ARG2L(scan);
                 ST.close_paren = ARG(scan);
@@ -3589,7 +3666,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             /* NOTREACHED */
         case EVAL:  /*   /(?{A})B/   /(??{A})B/  and /(?(?{A})X|Y)B/   */        
             if (cur_eval && cur_eval->locinput==locinput) {
-                if ( ++nochange_depth > MAX_RECURSE_EVAL_NOCHANGE_DEPTH ) 
+		if ( ++nochange_depth > max_nochange_depth )
                     Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex");
             } else {
                 nochange_depth = 0;
@@ -3607,7 +3684,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		DEBUG_STATE_r( PerlIO_printf(Perl_debug_log, 
 		    "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
 		PAD_SAVE_LOCAL(old_comppad, (PAD*)rexi->data->data[n + 2]);
-		PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
+		PL_regoffs[0].end = PL_reg_magic->mg_len = locinput - PL_bostr;
 
                 if (sv_yes_mark) {
                     SV *sv_mrk = get_sv("REGMARK", 1);
@@ -3637,42 +3714,80 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		{
 		    /* extract RE object from returned value; compiling if
 		     * necessary */
-
 		    MAGIC *mg = NULL;
-		    const SV *sv;
-		    if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
-			mg = mg_find(sv, PERL_MAGIC_qr);
-		    else if (SvSMAGICAL(ret)) {
-			if (SvGMAGICAL(ret))
+		    REGEXP *rx = NULL;
+
+		    if (SvROK(ret)) {
+			SV *const sv = SvRV(ret);
+
+			if (SvTYPE(sv) == SVt_REGEXP) {
+			    rx = (REGEXP*) sv;
+			} else if (SvSMAGICAL(sv)) {
+			    mg = mg_find(sv, PERL_MAGIC_qr);
+			    assert(mg);
+			}
+		    } else if (SvTYPE(ret) == SVt_REGEXP) {
+			rx = (REGEXP*) ret;
+		    } else if (SvSMAGICAL(ret)) {
+			if (SvGMAGICAL(ret)) {
+			    /* I don't believe that there is ever qr magic
+			       here.  */
+			    assert(!mg_find(ret, PERL_MAGIC_qr));
 			    sv_unmagic(ret, PERL_MAGIC_qr);
-			else
+			}
+			else {
 			    mg = mg_find(ret, PERL_MAGIC_qr);
+			    /* testing suggests mg only ends up non-NULL for
+			       scalars who were upgraded and compiled in the
+			       else block below. In turn, this is only
+			       triggered in the "postponed utf8 string" tests
+			       in t/op/pat.t  */
+			}
 		    }
 
 		    if (mg) {
-			re = (regexp *)mg->mg_obj;
-			(void)ReREFCNT_inc(re);
+			rx = (REGEXP *) mg->mg_obj; /*XXX:dmq*/
+			assert(rx);
+		    }
+		    if (rx) {
+			rx = reg_temp_copy(rx);
 		    }
 		    else {
-			STRLEN len;
-			const char * const t = SvPV_const(ret, len);
-			PMOP pm;
+			U32 pm_flags = 0;
 			const I32 osize = PL_regsize;
 
-			Zero(&pm, 1, PMOP);
-			if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
-			re = CALLREGCOMP((char*)t, (char*)t + len, &pm);
+			if (DO_UTF8(ret)) {
+			    assert (SvUTF8(ret));
+			} else if (SvUTF8(ret)) {
+			    /* Not doing UTF-8, despite what the SV says. Is
+			       this only if we're trapped in use 'bytes'?  */
+			    /* Make a copy of the octet sequence, but without
+			       the flag on, as the compiler now honours the
+			       SvUTF8 flag on ret.  */
+			    STRLEN len;
+			    const char *const p = SvPV(ret, len);
+			    ret = newSVpvn_flags(p, len, SVs_TEMP);
+			}
+			rx = CALLREGCOMP(ret, pm_flags);
 			if (!(SvFLAGS(ret)
 			      & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
-				| SVs_GMG)))
-			    sv_magic(ret,(SV*)ReREFCNT_inc(re),
-					PERL_MAGIC_qr,0,0);
+				 | SVs_GMG))) {
+			    /* This isn't a first class regexp. Instead, it's
+			       caching a regexp onto an existing, Perl visible
+			       scalar.  */
+			    sv_magic(ret, (SV*) rx, PERL_MAGIC_qr, 0, 0);
+			}
 			PL_regsize = osize;
 		    }
+		    re_sv = rx;
+		    re = (struct regexp *)SvANY(rx);
 		}
+                RXp_MATCH_COPIED_off(re);
+                re->subbeg = rex->subbeg;
+                re->sublen = rex->sublen;
 		rei = RXi_GET(re);
                 DEBUG_EXECUTE_r(
-                    debug_start_match(re, do_utf8, locinput, PL_regeol, 
+                    debug_start_match(re_sv, do_utf8, locinput, PL_regeol, 
                         "Matching embedded");
 		);		
 		startpoint = rei->program + 1;
@@ -3691,11 +3806,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		ST.cp = regcppush(0);	/* Save *all* the positions. */
 		REGCP_SET(ST.lastcp);
 		
-		PL_regstartp = re->startp; /* essentially NOOP on GOSUB */
-		PL_regendp = re->endp;     /* essentially NOOP on GOSUB */
+		PL_regoffs = re->offs; /* essentially NOOP on GOSUB */
 		
-		*PL_reglastparen = 0;
-		*PL_reglastcloseparen = 0;
+		/* see regtry, specifically PL_reglast(?:close)?paren is a pointer! (i dont know why) :dmq */
+		PL_reglastparen = &re->lastparen;
+		PL_reglastcloseparen = &re->lastcloseparen;
+		re->lastparen = 0;
+		re->lastcloseparen = 0;
+
 		PL_reginput = locinput;
 		PL_regsize = 0;
 
@@ -3703,14 +3821,15 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		PL_reg_maxiter = 0;
 
 		ST.toggle_reg_flags = PL_reg_flags;
-		if (re->extflags & RXf_UTF8)
+		if (RX_UTF8(re_sv))
 		    PL_reg_flags |= RF_utf8;
 		else
 		    PL_reg_flags &= ~RF_utf8;
 		ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
 
-		ST.prev_rex = rex;
+		ST.prev_rex = rex_sv;
 		ST.prev_curlyx = cur_curlyx;
+		SETREX(rex_sv,re_sv);
 		rex = re;
 		rexi = rei;
 		cur_curlyx = NULL;
@@ -3730,23 +3849,34 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	case EVAL_AB: /* cleanup after a successful (??{A})B */
 	    /* note: this is called twice; first after popping B, then A */
 	    PL_reg_flags ^= ST.toggle_reg_flags; 
-	    ReREFCNT_dec(rex);
-	    rex = ST.prev_rex;
+	    ReREFCNT_dec(rex_sv);
+	    SETREX(rex_sv,ST.prev_rex);
+	    rex = (struct regexp *)SvANY(rex_sv);
 	    rexi = RXi_GET(rex);
 	    regcpblow(ST.cp);
 	    cur_eval = ST.prev_eval;
 	    cur_curlyx = ST.prev_curlyx;
+	    
+	    PL_reglastparen = &rex->lastparen;
+	    PL_reglastcloseparen = &rex->lastcloseparen;
+	    
 	    /* XXXX This is too dramatic a measure... */
 	    PL_reg_maxiter = 0;
+            if ( nochange_depth )
+	        nochange_depth--;
 	    sayYES;
 
 
 	case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
 	    /* note: this is called twice; first after popping B, then A */
 	    PL_reg_flags ^= ST.toggle_reg_flags; 
-	    ReREFCNT_dec(rex);
-	    rex = ST.prev_rex;
+	    ReREFCNT_dec(rex_sv);
+	    SETREX(rex_sv,ST.prev_rex);
+	    rex = (struct regexp *)SvANY(rex_sv);
 	    rexi = RXi_GET(rex); 
+	    PL_reglastparen = &rex->lastparen;
+	    PL_reglastcloseparen = &rex->lastcloseparen;
+
 	    PL_reginput = locinput;
 	    REGCP_UNWIND(ST.lastcp);
 	    regcppop(rex);
@@ -3754,6 +3884,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    cur_curlyx = ST.prev_curlyx;
 	    /* XXXX This is too dramatic a measure... */
 	    PL_reg_maxiter = 0;
+	    if ( nochange_depth )
+	        nochange_depth--;
 	    sayNO_SILENT;
 #undef ST
 
@@ -3766,8 +3898,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    break;
 	case CLOSE:
 	    n = ARG(scan);  /* which paren pair */
-	    PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
-	    PL_regendp[n] = locinput - PL_bostr;
+	    PL_regoffs[n].start = PL_reg_start_tmp[n] - PL_bostr;
+	    PL_regoffs[n].end = locinput - PL_bostr;
 	    /*if (n > PL_regsize)
 		PL_regsize = n;*/
 	    if (n > *PL_reglastparen)
@@ -3787,8 +3919,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
                     if ( OP(cursor)==CLOSE ){
                         n = ARG(cursor);
                         if ( n <= lastopen ) {
-                            PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
-                            PL_regendp[n] = locinput - PL_bostr;
+                            PL_regoffs[n].start
+				= PL_reg_start_tmp[n] - PL_bostr;
+                            PL_regoffs[n].end = locinput - PL_bostr;
                             /*if (n > PL_regsize)
                             PL_regsize = n;*/
                             if (n > *PL_reglastparen)
@@ -3805,7 +3938,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    /*NOTREACHED*/	    
 	case GROUPP:
 	    n = ARG(scan);  /* which paren pair */
-	    sw = (bool)(*PL_reglastparen >= n && PL_regendp[n] != -1);
+	    sw = (bool)(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
 	    break;
 	case NGROUPP:
 	    /* reg_check_named_buff_matched returns 0 for no match */
@@ -3953,15 +4086,6 @@ NULL
 	}
 
 	case CURLYX_end: /* just finished matching all of A*B */
-	    if (PL_reg_eval_set){
-		SV *pres= GvSV(PL_replgv);
-		SvREFCNT_inc(pres);
-		regcpblow(ST.cp);
-		sv_setsv(GvSV(PL_replgv), pres);
-		SvREFCNT_dec(pres);
-	    } else {
-		regcpblow(ST.cp);
-	    }
 	    cur_curlyx = ST.prev_curlyx;
 	    sayYES;
 	    /* NOTREACHED */
@@ -4182,12 +4306,6 @@ NULL
 
 	case BRANCH:	    /*  /(...|A|...)/ */
 	    scan = NEXTOPER(scan); /* scan now points to inner node */
-	    if ((!next || (OP(next) != BRANCH && OP(next) != BRANCHJ)) 
-	        && !has_cutgroup)
-	    {
-	    	/* last branch; skip state push and jump direct to node */
-		continue;
-            }
 	    ST.lastparen = *PL_reglastparen;
 	    ST.next_branch = next;
 	    REGCP_SET(ST.cp);
@@ -4223,7 +4341,7 @@ NULL
 	    }
 	    REGCP_UNWIND(ST.cp);
 	    for (n = *PL_reglastparen; n > ST.lastparen; n--)
-		PL_regendp[n] = -1;
+		PL_regoffs[n].end = -1;
 	    *PL_reglastparen = n;
 	    /*dmq: *PL_reglastcloseparen = n; */
 	    scan = ST.next_branch;
@@ -4388,13 +4506,13 @@ NULL
 		/* mark current A as captured */
 		I32 paren = ST.me->flags;
 		if (ST.count) {
-		    PL_regstartp[paren]
+		    PL_regoffs[paren].start
 			= HOPc(PL_reginput, -ST.alen) - PL_bostr;
-		    PL_regendp[paren] = PL_reginput - PL_bostr;
+		    PL_regoffs[paren].end = PL_reginput - PL_bostr;
 		    /*dmq: *PL_reglastcloseparen = paren; */
 		}
 		else
-		    PL_regendp[paren] = -1;
+		    PL_regoffs[paren].end = -1;
 		if (cur_eval && cur_eval->u.eval.close_paren &&
 		    cur_eval->u.eval.close_paren == (U32)ST.me->flags) 
 		{
@@ -4428,12 +4546,12 @@ NULL
 #define CURLY_SETPAREN(paren, success) \
     if (paren) { \
 	if (success) { \
-	    PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr; \
-	    PL_regendp[paren] = locinput - PL_bostr; \
+	    PL_regoffs[paren].start = HOPc(locinput, -1) - PL_bostr; \
+	    PL_regoffs[paren].end = locinput - PL_bostr; \
 	    *PL_reglastcloseparen = paren; \
 	} \
 	else \
-	    PL_regendp[paren] = -1; \
+	    PL_regoffs[paren].end = -1; \
     }
 
 	case STAR:		/*  /A*B/ where A is width 1 */
@@ -4606,7 +4724,7 @@ NULL
 	case CURLY_B_min_known_fail:
 	    /* failed to find B in a non-greedy match where c1,c2 valid */
 	    if (ST.paren && ST.count)
-		PL_regendp[ST.paren] = -1;
+		PL_regoffs[ST.paren].end = -1;
 
 	    PL_reginput = locinput;	/* Could be reset... */
 	    REGCP_UNWIND(ST.cp);
@@ -4684,7 +4802,7 @@ NULL
 	case CURLY_B_min_fail:
 	    /* failed to find B in a non-greedy match where c1,c2 invalid */
 	    if (ST.paren && ST.count)
-		PL_regendp[ST.paren] = -1;
+		PL_regoffs[ST.paren].end = -1;
 
 	    REGCP_UNWIND(ST.cp);
 	    /* failed -- move forward one */
@@ -4731,7 +4849,7 @@ NULL
 	case CURLY_B_max_fail:
 	    /* failed to find B in a greedy match */
 	    if (ST.paren && ST.count)
-		PL_regendp[ST.paren] = -1;
+		PL_regoffs[ST.paren].end = -1;
 
 	    REGCP_UNWIND(ST.cp);
 	    /*  back up. */
@@ -4747,17 +4865,16 @@ NULL
 	    if (cur_eval) {
 		/* we've just finished A in /(??{A})B/; now continue with B */
 		I32 tmpix;
-
-
 		st->u.eval.toggle_reg_flags
 			    = cur_eval->u.eval.toggle_reg_flags;
 		PL_reg_flags ^= st->u.eval.toggle_reg_flags; 
 
-		st->u.eval.prev_rex = rex;		/* inner */
-		rex  = cur_eval->u.eval.prev_rex;	/* outer */
+		st->u.eval.prev_rex = rex_sv;		/* inner */
+		SETREX(rex_sv,cur_eval->u.eval.prev_rex);
+		rex = (struct regexp *)SvANY(rex_sv);
 		rexi = RXi_GET(rex);
 		cur_curlyx = cur_eval->u.eval.prev_curlyx;
-		ReREFCNT_inc(rex);
+		ReREFCNT_inc(rex_sv);
 		st->u.eval.cp = regcppush(0);	/* Save *all* the positions. */
 		REGCP_SET(st->u.eval.lastcp);
 		PL_reginput = locinput;
@@ -4774,7 +4891,10 @@ NULL
 		DEBUG_EXECUTE_r(
 		    PerlIO_printf(Perl_debug_log, "%*s  EVAL trying tail ... %"UVxf"\n",
 				      REPORT_CODE_OFF+depth*2, "",PTR2UV(cur_eval)););
-		PUSH_YES_STATE_GOTO(EVAL_AB,
+                if ( nochange_depth )
+	            nochange_depth--;
+
+                PUSH_YES_STATE_GOTO(EVAL_AB,
 			st->u.eval.prev_eval->u.eval.B); /* match B */
 	    }
 
@@ -4964,6 +5084,55 @@ NULL
             sayNO;
             /* NOTREACHED */
 #undef ST
+        case FOLDCHAR:
+            n = ARG(scan);
+            if ( n == (U32)what_len_TRICKYFOLD(locinput,do_utf8,ln) ) {
+                locinput += ln;
+            } else if ( 0xDF == n && !do_utf8 && !UTF ) {
+                sayNO;
+            } else  {
+                U8 folded[UTF8_MAXBYTES_CASE+1];
+                STRLEN foldlen;
+                const char * const l = locinput;
+                char *e = PL_regeol;
+                to_uni_fold(n, folded, &foldlen);
+
+		if (ibcmp_utf8((const char*) folded, 0,  foldlen, 1,
+                	       l, &e, 0,  do_utf8)) {
+                        sayNO;
+                }
+                locinput = e;
+            } 
+            nextchr = UCHARAT(locinput);  
+            break;
+        case LNBREAK:
+            if ((n=is_LNBREAK(locinput,do_utf8))) {
+                locinput += n;
+                nextchr = UCHARAT(locinput);
+            } else
+                sayNO;
+            break;
+
+#define CASE_CLASS(nAmE)                              \
+        case nAmE:                                    \
+            if ((n=is_##nAmE(locinput,do_utf8))) {    \
+                locinput += n;                        \
+                nextchr = UCHARAT(locinput);          \
+            } else                                    \
+                sayNO;                                \
+            break;                                    \
+        case N##nAmE:                                 \
+            if ((n=is_##nAmE(locinput,do_utf8))) {    \
+                sayNO;                                \
+            } else {                                  \
+                locinput += UTF8SKIP(locinput);       \
+                nextchr = UCHARAT(locinput);          \
+            }                                         \
+            break
+
+        CASE_CLASS(VERTWS);
+        CASE_CLASS(HORIZWS);
+#undef CASE_CLASS
 
 	default:
 	    PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
@@ -4999,7 +5168,7 @@ NULL
                     }
                     PerlIO_printf(Perl_error_log, "%*s#%-3d %-10s %s\n",
                         REPORT_CODE_OFF + 2 + depth * 2,"",
-                        curd, reg_name[cur->resume_state],
+                        curd, PL_reg_name[cur->resume_state],
                         (curyes == cur) ? "yes" : ""
                     );
                     if (curyes == cur)
@@ -5078,6 +5247,15 @@ yes:
     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
 			  PL_colors[4], PL_colors[5]));
 
+    if (PL_reg_eval_set) {
+	/* each successfully executed (?{...}) block does the equivalent of
+	 *   local $^R = do {...}
+	 * When popping the save stack, all these locals would be undone;
+	 * bypass this by setting the outermost saved $^R to the latest
+	 * value */
+	if (oreplsv != GvSV(PL_replgv))
+	    sv_setsv(oreplsv, GvSV(PL_replgv));
+    }
     result = 1;
     goto final_exit;
 
@@ -5134,20 +5312,9 @@ no_silent:
         sv_setsv(sv_err, sv_commit);
         sv_setsv(sv_mrk, sv_yes_mark);
     }
-    /* restore original high-water mark */
-    PL_regmatch_slab  = orig_slab;
-    PL_regmatch_state = orig_state;
-
-    /* free all slabs above current one */
-    if (orig_slab->next) {
-	regmatch_slab *sl = orig_slab->next;
-	orig_slab->next = NULL;
-	while (sl) {
-	    regmatch_slab * const osl = sl;
-	    sl = sl->next;
-	    Safefree(osl);
-	}
-    }
+
+    /* clean up; in particular, free all slabs above current one */
+    LEAVE_SCOPE(oldsave);
 
     return result;
 }
@@ -5334,8 +5501,8 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
 	} else {
 	    while (scan < loceol && !isSPACE(*scan))
 		scan++;
-	    break;
 	}
+	break;
     case NSPACEL:
 	PL_reg_flags |= RF_tainted;
 	if (do_utf8) {
@@ -5377,7 +5544,77 @@ S_regrepeat(pTHX_ const regexp *prog, const regnode *p, I32 max, int depth)
 	    while (scan < loceol && !isDIGIT(*scan))
 		scan++;
 	}
+    case LNBREAK:
+        if (do_utf8) {
+	    loceol = PL_regeol;
+	    while (hardcount < max && scan < loceol && (c=is_LNBREAK_utf8(scan))) {
+		scan += c;
+		hardcount++;
+	    }
+	} else {
+	    /*
+	      LNBREAK can match two latin chars, which is ok,
+	      because we have a null terminated string, but we
+	      have to use hardcount in this situation
+	    */
+	    while (scan < loceol && (c=is_LNBREAK_latin1(scan)))  {
+		scan+=c;
+		hardcount++;
+	    }
+	}	
+	break;
+    case HORIZWS:
+        if (do_utf8) {
+	    loceol = PL_regeol;
+	    while (hardcount < max && scan < loceol && (c=is_HORIZWS_utf8(scan))) {
+		scan += c;
+		hardcount++;
+	    }
+	} else {
+	    while (scan < loceol && is_HORIZWS_latin1(scan)) 
+		scan++;		
+	}	
+	break;
+    case NHORIZWS:
+        if (do_utf8) {
+	    loceol = PL_regeol;
+	    while (hardcount < max && scan < loceol && !is_HORIZWS_utf8(scan)) {
+		scan += UTF8SKIP(scan);
+		hardcount++;
+	    }
+	} else {
+	    while (scan < loceol && !is_HORIZWS_latin1(scan))
+		scan++;
+
+	}	
+	break;
+    case VERTWS:
+        if (do_utf8) {
+	    loceol = PL_regeol;
+	    while (hardcount < max && scan < loceol && (c=is_VERTWS_utf8(scan))) {
+		scan += c;
+		hardcount++;
+	    }
+	} else {
+	    while (scan < loceol && is_VERTWS_latin1(scan)) 
+		scan++;
+
+	}	
 	break;
+    case NVERTWS:
+        if (do_utf8) {
+	    loceol = PL_regeol;
+	    while (hardcount < max && scan < loceol && !is_VERTWS_utf8(scan)) {
+		scan += UTF8SKIP(scan);
+		hardcount++;
+	    }
+	} else {
+	    while (scan < loceol && !is_VERTWS_latin1(scan)) 
+		scan++;
+          
+	}	
+	break;
+
     default:		/* Called on something of 0 width. */
 	break;		/* So match right here or not at all. */
     }
@@ -5431,8 +5668,8 @@ Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool
 	     * documentation of these array elements. */
 
 	    si = *ary;
-	    a  = SvROK(ary[1]) ? &ary[1] : 0;
-	    b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
+	    a  = SvROK(ary[1]) ? &ary[1] : NULL;
+	    b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : NULL;
 
 	    if (a)
 		sw = *a;
@@ -5678,7 +5915,7 @@ restore_pos(pTHX_ void *arg)
 #ifdef PERL_OLD_COPY_ON_WRITE
 	    rex->saved_copy = PL_nrs;
 #endif
-	    RX_MATCH_COPIED_on(rex);
+	    RXp_MATCH_COPIED_on(rex);
 	}
 	PL_reg_magic->mg_len = PL_reg_oldpos;
 	PL_reg_eval_set = 0;