patch to support computed regular subexpressions

	Message-Id: <199808201919.PAA04692@monk.mps.ohio-state.edu>
	Subject: [5.005_5* PATCH] Postponed RE - now!

p4raw-id: //depot/perl@1813

1 files changed, 152 insertions, 10 deletions

diff --git a/regexec.c b/regexec.c
index 603120f72b..0627e2b154 100644
--- a/regexec.c
+++ b/regexec.c
@@ -73,6 +73,8 @@
  */
 #include "EXTERN.h"
 #include "perl.h"
+typedef MAGIC *my_magic;
+
 #include "regcomp.h"
 
 #define RF_tainted	1		/* tainted information used? */
@@ -201,6 +203,25 @@ regcppop(void)
     return input;
 }
 
+STATIC char *
+regcp_set_to(I32 ss)
+{
+    I32 tmp = PL_savestack_ix;
+
+    PL_savestack_ix = ss;
+    regcppop();
+    PL_savestack_ix = tmp;
+}
+
+typedef struct re_cc_state
+{
+    I32 ss;
+    regnode *node;
+    struct re_cc_state *prev;
+    CURCUR *cc;
+    regexp *re;
+} re_cc_state;
+
 #define regcpblow(cp) LEAVE_SCOPE(cp)
 
 /*
@@ -222,6 +243,18 @@ pregexec(register regexp *prog, char *stringarg, register char *strend,
 	regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL, 
 		      nosave ? 0 : REXEC_COPY_STR);
 }
+
+STATIC void
+cache_re(regexp *prog)
+{
+    PL_regprecomp = prog->precomp;		/* Needed for FAIL. */
+#ifdef DEBUGGING
+    PL_regprogram = prog->program;
+#endif
+    PL_regnpar = prog->nparens;
+    PL_regdata = prog->data;    
+    PL_reg_re = prog;    
+}
   
 /*
  - regexec_flags - match a regexp against a string
@@ -254,10 +287,9 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
     cc.oldcc = 0;
     PL_regcc = &cc;
 
-    PL_regprecomp = prog->precomp;		/* Needed for error messages. */
+    cache_re(prog);
 #ifdef DEBUGGING
     PL_regnarrate = PL_debug & 512;
-    PL_regprogram = prog->program;
 #endif
 
     /* Be paranoid... */
@@ -282,7 +314,6 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
 	FAIL("corrupted regexp program");
     }
 
-    PL_regnpar = prog->nparens;
     PL_reg_flags = 0;
     PL_reg_eval_set = 0;
 
@@ -299,6 +330,9 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
     /* see how far we have to get to not match where we matched before */
     PL_regtill = startpos+minend;
 
+    /* We start without call_cc context.  */
+    PL_reg_call_cc = 0;
+
     /* If there is a "must appear" string, look for it. */
     s = startpos;
     if (!(flags & REXEC_CHECKED) 
@@ -360,8 +394,6 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend,
 		      (strend - startpos > 60 ? "..." : ""))
 	);
 
-    PL_regdata = prog->data;
-
     /* Simplest case:  anchored match need be tried only once. */
     /*  [unless only anchor is BOL and multiline is set] */
     if (prog->reganch & ROPT_ANCH) {
@@ -1552,15 +1584,91 @@ regmatch(regnode *prog)
 	    ret = POPs;
 	    PUTBACK;
 	    
+	    PL_op = oop;
+	    PL_curpad = ocurpad;
+	    PL_curcop = ocurcop;
 	    if (logical) {
-		logical = 0;
+		if (logical == 2) {	/* Postponed subexpression. */
+		    regexp *re;
+		    my_magic mg = Null(my_magic);
+		    re_cc_state state;
+		    CURCUR cctmp;
+		    CHECKPOINT cp, lastcp;
+
+		    if(SvROK(ret) || SvRMAGICAL(ret)) {
+			SV *sv = SvROK(ret) ? SvRV(ret) : ret;
+
+			if(SvMAGICAL(sv))
+			    mg = mg_find(sv, 'r');
+		    }
+		    if (mg) {
+			re = (regexp *)mg->mg_obj;
+			ReREFCNT_inc(re);
+		    }
+		    else {
+			STRLEN len;
+			char *t = SvPV(ret, len);
+			PMOP pm;
+			char *oprecomp = PL_regprecomp;
+			I32 osize = PL_regsize;
+			I32 onpar = PL_regnpar;
+
+			pm.op_pmflags = 0;
+			re = CALLREGCOMP(t, t + len, &pm);
+			if (!(SvFLAGS(ret) 
+			      & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
+			    sv_magic(ret,(SV*)ReREFCNT_inc(re),'r',0,0);
+			PL_regprecomp = oprecomp;
+			PL_regsize = osize;
+			PL_regnpar = onpar;
+		    }
+		    DEBUG_r(
+			PerlIO_printf(Perl_debug_log, 
+				      "Entering embedded `%s%.60s%s%s'\n",
+				      PL_colors[0],
+				      re->precomp,
+				      PL_colors[1],
+				      (strlen(re->precomp) > 60 ? "..." : ""))
+			);
+		    state.node = next;
+		    state.prev = PL_reg_call_cc;
+		    state.cc = PL_regcc;
+		    state.re = PL_reg_re;
+
+		    cctmp.cur = 0;
+		    cctmp.oldcc = 0;
+		    PL_regcc = &cctmp;
+		    
+		    cp = regcppush(0);	/* Save *all* the positions. */
+		    REGCP_SET;
+		    cache_re(re);
+		    state.ss = PL_savestack_ix;
+		    *PL_reglastparen = 0;
+		    PL_reg_call_cc = &state;
+		    PL_reginput = locinput;
+		    if (regmatch(re->program + 1)) {
+			ReREFCNT_dec(re);
+			regcpblow(cp);
+			sayYES;
+		    }
+		    DEBUG_r(
+			PerlIO_printf(Perl_debug_log,
+				      "%*s  failed...\n",
+				      REPORT_CODE_OFF+PL_regindent*2, "")
+			);
+		    ReREFCNT_dec(re);
+		    REGCP_UNWIND;
+		    regcppop();
+		    PL_reg_call_cc = state.prev;
+		    PL_regcc = state.cc;
+		    PL_reg_re = state.re;
+		    sayNO;
+		}
 		sw = SvTRUE(ret);
+		logical = 0;
 	    }
 	    else
 		sv_setsv(save_scalar(PL_replgv), ret);
-	    PL_op = oop;
-	    PL_curpad = ocurpad;
-	    PL_curcop = ocurcop;
 	    break;
 	}
 	case OPEN:
@@ -1590,7 +1698,7 @@ regmatch(regnode *prog)
 	    }
 	    break;
 	case LOGICAL:
-	    logical = 1;
+	    logical = scan->flags;
 	    break;
 	case CURLYX: {
 		CURCUR cc;
@@ -2086,6 +2194,40 @@ regmatch(regnode *prog)
 	    sayNO;
 	    break;
 	case END:
+	    if (PL_reg_call_cc) {
+		re_cc_state *cur_call_cc = PL_reg_call_cc;
+		CURCUR *cctmp = PL_regcc;
+		regexp *re = PL_reg_re;
+		CHECKPOINT cp, lastcp;
+		
+		cp = regcppush(0);	/* Save *all* the positions. */
+		REGCP_SET;
+		regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
+						    the caller. */
+		PL_reginput = locinput;	/* Make position available to
+					   the callcc. */
+		cache_re(PL_reg_call_cc->re);
+		PL_regcc = PL_reg_call_cc->cc;
+		PL_reg_call_cc = PL_reg_call_cc->prev;
+		if (regmatch(cur_call_cc->node)) {
+		    PL_reg_call_cc = cur_call_cc;
+		    regcpblow(cp);
+		    sayYES;
+		}
+		REGCP_UNWIND;
+		regcppop();
+		PL_reg_call_cc = cur_call_cc;
+		PL_regcc = cctmp;
+		PL_reg_re = re;
+		cache_re(re);
+
+		DEBUG_r(
+		    PerlIO_printf(Perl_debug_log,
+				  "%*s  continuation failed...\n",
+				  REPORT_CODE_OFF+PL_regindent*2, "")
+		    );
+		sayNO;
+	    }
 	    if (locinput < PL_regtill)
 		sayNO;			/* Cannot match: too short. */
 	    /* Fall through */