This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
change re_op_compile() to take a list of SVs
authorDavid Mitchell <davem@iabyn.com>
Wed, 26 Oct 2011 11:23:52 +0000 (12:23 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 13 Jun 2012 12:25:50 +0000 (13:25 +0100)
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.

embed.fnc
embed.h
op.c
proto.h
regcomp.c

index da4f720..128cc68 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1058,8 +1058,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 12be81a..7dea742 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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 75667df..e2607fe 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4426,7 +4426,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 abdf657..fef000f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3150,7 +3150,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__;
index 9449288..14261a7 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4965,7 +4965,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
@@ -5000,8 +5000,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
@@ -5017,7 +5018,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;
@@ -5144,7 +5146,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;