X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regexec.c;h=2b7ae4a44514bc59c2663bc3f9545546fd8bd57d;hb=288b8c02c5ee89a2978a1b9e56ed255c53beb793;hp=59fc53e05188620cdef7ab53c4fd919c16313938;hpb=84679df57ca0626f7fb35fc3038e2e142b97f8a4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regexec.c b/regexec.c
index 59fc53e..2b7ae4a 100644
--- a/regexec.c
+++ b/regexec.c
@@ -371,10 +371,11 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend,
    deleted from the finite automaton. */
 
 char *
-Perl_re_intuit_start(pTHX_ REGEXP * const prog, SV *sv, char *strpos,
+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;
@@ -394,7 +395,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const 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) {
 	PL_reg_flags |= RF_utf8;
@@ -1742,7 +1743,7 @@ S_swap_match_buff (pTHX_ regexp *prog) {
  - regexec_flags - match a regexp against a string
  */
 I32
-Perl_regexec_flags(pTHX_ REGEXP * const 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 */
@@ -1753,6 +1754,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
 /* nosave: For optimizations. */
 {
     dVAR;
+    struct regexp *const prog = (struct regexp *)SvANY(rx);
     /*register*/ char *s;
     register regnode *c;
     /*register*/ char *startpos = stringarg;
@@ -1778,9 +1780,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
     }
 
     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, 
         "Matching");
@@ -1842,7 +1844,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
 	} 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? */
@@ -1852,7 +1854,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
 
 	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 */
@@ -1885,7 +1887,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
 		    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;
 		    }
@@ -2144,7 +2146,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st
     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)
 	restore_pos(aTHX_ prog);
@@ -2153,7 +2155,7 @@ got_it:
 
     /* 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
@@ -2170,7 +2172,7 @@ got_it:
 	    } else
 #endif
 	    {
-		RX_MATCH_COPIED_on(prog);
+		RX_MATCH_COPIED_on(rx);
 		s = savepvn(strbeg, i);
 		prog->subbeg = s;
 	    }
@@ -2205,7 +2207,8 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
 {
     dVAR;
     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;
@@ -2261,7 +2264,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos)
             }
 #endif      
         }
-	PM_SETRE(PL_reg_curpm, prog);
+	PM_SETRE(PL_reg_curpm, rx);
 	PL_reg_oldcurpm = PL_curpm;
 	PL_curpm = PL_reg_curpm;
 	if (RXp_MATCH_COPIED(prog)) {
@@ -2696,7 +2699,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
     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);
     
     I32	oldsave;
@@ -3629,6 +3633,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 #define ST st->u.eval
 	{
 	    SV *ret;
+	    SV *re_sv;
             regexp *re;
             regexp_internal *rei;
             regnode *startpoint;
@@ -3645,9 +3650,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
             } 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);
@@ -3708,19 +3714,19 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    /* extract RE object from returned value; compiling if
 		     * necessary */
 		    MAGIC *mg = NULL;
-		    re = NULL;
+		    REGEXP *rx = NULL;
 
 		    if (SvROK(ret)) {
-			const SV *const sv = SvRV(ret);
+			SV *const sv = SvRV(ret);
 
 			if (SvTYPE(sv) == SVt_REGEXP) {
-			    re = ((struct xregexp *)SvANY(sv))->xrx_regexp;
+			    rx = sv;
 			} else if (SvSMAGICAL(sv)) {
 			    mg = mg_find(sv, PERL_MAGIC_qr);
 			    assert(mg);
 			}
 		    } else if (SvTYPE(ret) == SVt_REGEXP) {
-			re = ((struct xregexp *)SvANY(ret))->xrx_regexp;
+			rx = ret;
 		    } else if (SvSMAGICAL(ret)) {
 			if (SvGMAGICAL(ret)) {
 			    /* I don't believe that there is ever qr magic
@@ -3739,28 +3745,30 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    }
 
 		    if (mg) {
-			re = (regexp *)mg->mg_obj; /*XXX:dmq*/
+			rx = mg->mg_obj; /*XXX:dmq*/
 			assert(re);
 		    }
-		    if (re)
-			re = reg_temp_copy(re);
+		    if (rx) {
+			rx = reg_temp_copy(rx);
+		    }
 		    else {
 			U32 pm_flags = 0;
 			const I32 osize = PL_regsize;
 
 			if (DO_UTF8(ret)) pm_flags |= RXf_UTF8;
-			re = CALLREGCOMP(ret, pm_flags);
+			rx = CALLREGCOMP(ret, pm_flags);
 			if (!(SvFLAGS(ret)
 			      & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
 				 | 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*)ReREFCNT_inc(re),
-					PERL_MAGIC_qr,0,0);
+			    sv_magic(ret, 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;
@@ -3803,9 +3811,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		    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,re);
+		SETREX(rex_sv,re_sv);
+		rex = re;
 		rexi = rei;
 		cur_curlyx = NULL;
 		ST.B = next;
@@ -3824,8 +3833,9 @@ 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);
-	    SETREX(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;
@@ -3840,8 +3850,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	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);
-	    SETREX(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_reginput = locinput;
 	    REGCP_UNWIND(ST.lastcp);
@@ -4835,11 +4846,12 @@ NULL
 			    = cur_eval->u.eval.toggle_reg_flags;
 		PL_reg_flags ^= st->u.eval.toggle_reg_flags; 
 
-		st->u.eval.prev_rex = rex;		/* inner */
-		SETREX(rex,cur_eval->u.eval.prev_rex);
+		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;