change re_op_compile() to take a list of SVs

rather than passing a single SV string containing the pattern,
allow a list of SVs (plus count) to be passed. For the moment, only allow
that list to be one element long, but this will allow us to directly
pass in the list of SVs normally pre-processed into a single SV by
pp_regcomp.

5 files changed, 15 insertions, 10 deletions

diff --git a/embed.fnc b/embed.fnc
index 8d59419bea..5f7f8b6c7f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1045,8 +1045,8 @@ Ap	|void*	|regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param
 #endif
 p	|regexp_engine*|current_re_engine
 Ap	|REGEXP*|pregcomp	|NN SV * const pattern|const U32 flags
-p	|REGEXP*|re_op_compile	|NULLOK SV * const pattern|NULLOK OP *expr \
-				|U32 flags
+p	|REGEXP*|re_op_compile	|NULLOK SV * const * const patternp \
+				|int pat_count|NULLOK OP *expr|U32 flags
 Ap	|REGEXP*|re_compile	|NN SV * const pattern|U32 flags
 Ap	|char*	|re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|NN char* strpos \
 				|NN char* strend|const U32 flags \
diff --git a/embed.h b/embed.h
index 0da8c6fc6d..c330eab14e 100644
--- a/embed.h
+++ b/embed.h
@@ -1155,7 +1155,7 @@
 #define parser_free(a)		Perl_parser_free(aTHX_ a)
 #define peep(a)			Perl_peep(aTHX_ a)
 #define pmruntime(a,b,c,d)	Perl_pmruntime(aTHX_ a,b,c,d)
-#define re_op_compile(a,b,c)	Perl_re_op_compile(aTHX_ a,b,c)
+#define re_op_compile(a,b,c,d)	Perl_re_op_compile(aTHX_ a,b,c,d)
 #define refcounted_he_chain_2hv(a,b)	Perl_refcounted_he_chain_2hv(aTHX_ a,b)
 #define refcounted_he_fetch_pv(a,b,c,d)	Perl_refcounted_he_fetch_pv(aTHX_ a,b,c,d)
 #define refcounted_he_fetch_pvn(a,b,c,d,e)	Perl_refcounted_he_fetch_pvn(aTHX_ a,b,c,d,e)
diff --git a/op.c b/op.c
index ffe46ac755..00ed4e0d9a 100644
--- a/op.c
+++ b/op.c
@@ -4371,7 +4371,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 	}
 	else {
 	    /* compile-time pattern that includes literal code blocks */
-	    REGEXP* re = re_op_compile(NULL, expr, pm_flags);
+	    REGEXP* re = re_op_compile(NULL, 0, expr, pm_flags);
 	    PM_SETRE(pm, re);
 	    if (pm->op_pmflags & PMf_HAS_CV) {
 		CV *cv;
diff --git a/proto.h b/proto.h
index 769fbbf577..734b45a131 100644
--- a/proto.h
+++ b/proto.h
@@ -3142,7 +3142,7 @@ PERL_CALLCONV SV*	Perl_re_intuit_string(pTHX_ REGEXP  *const r)
 #define PERL_ARGS_ASSERT_RE_INTUIT_STRING	\
 	assert(r)
 
-PERL_CALLCONV REGEXP*	Perl_re_op_compile(pTHX_ SV * const pattern, OP *expr, U32 flags);
+PERL_CALLCONV REGEXP*	Perl_re_op_compile(pTHX_ SV * const * const patternp, int pat_count, OP *expr, U32 flags);
 PERL_CALLCONV Malloc_t	Perl_realloc(Malloc_t where, MEM_SIZE nbytes)
 			__attribute__malloc__
 			__attribute__warn_unused_result__;
diff --git a/regcomp.c b/regcomp.c
index 4ec7b0dbc2..f7371d78db 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -4542,7 +4542,7 @@ REGEXP *
 Perl_re_compile(pTHX_ SV * const pattern, U32 orig_pm_flags)
 {
     PERL_ARGS_ASSERT_RE_COMPILE;
-    return Perl_re_op_compile(aTHX_ pattern, NULL, orig_pm_flags);
+    return Perl_re_op_compile(aTHX_ &pattern, 1, NULL, orig_pm_flags);
 }
 
 /* given a list of CONSTs and DO blocks in expr, append all the CONSTs to
@@ -4577,8 +4577,9 @@ S_get_pat_and_code_indices(pTHX_ RExC_state_t *pRExC_state, OP* expr, SV* pat) {
 /*
  * Perl_op_re_compile - the perl internal RE engine's function to compile a
  * regular expression into internal code.
- * The pattern may be passed either as a single SV string, or a list of
- * OPs.
+ * The pattern may be passed either as:
+ *    a list of SVs (patternp plus pat_count)
+ *    a list of OPs (expr)
  *
  * We can't allocate space until we know how big the compiled form will be,
  * but we can't compile it (and thus know how big it is) until we've got a
@@ -4594,7 +4595,8 @@ S_get_pat_and_code_indices(pTHX_ RExC_state_t *pRExC_state, OP* expr, SV* pat) {
  */
 
 REGEXP *
-Perl_re_op_compile(pTHX_ SV * const pattern, OP *expr, U32 orig_pm_flags)
+Perl_re_op_compile(pTHX_ SV * const * const patternp, int pat_count,
+		    OP *expr, U32 orig_pm_flags)
 {
     dVAR;
     REGEXP *rx;
@@ -4663,7 +4665,10 @@ Perl_re_op_compile(pTHX_ SV * const pattern, OP *expr, U32 orig_pm_flags)
 	}
     }
     else
-	pat = pattern;
+    {
+	assert(pat_count ==1); /*XXX*/
+	pat = *patternp;
+    }
 
     RExC_utf8 = RExC_orig_utf8 = SvUTF8(pat);
     RExC_uni_semantics = 0;