This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Add hook for re_dup() into regex engine as reg_dupe (make re pluggable...
authorYves Orton <demerphq@gmail.com>
Fri, 29 Sep 2006 12:41:26 +0000 (14:41 +0200)
committerH.Merijn Brand <h.m.brand@xs4all.nl>
Fri, 29 Sep 2006 12:29:24 +0000 (12:29 +0000)
Message-ID: <9b18b3110609290341p11767110sec20a6fee2038a00@mail.gmail.com>

p4raw-id: //depot/perl@28900

24 files changed:
MANIFEST
embed.fnc
embed.h
embedvar.h
ext/re/re.pm
ext/re/re.xs
ext/re/t/lexical_debug.pl [new file with mode: 0644]
ext/re/t/lexical_debug.t [new file with mode: 0644]
ext/re/t/re.t
op.c
perl.h
perlapi.h
pp.c
pp_ctl.c
pp_hot.c
proto.h
regcomp.c
regcomp.h
regcomp.pl
regexec.c
regexp.h
regnodes.h
sv.c
thrdvar.h

index e950504..64e5bf6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -985,6 +985,8 @@ ext/re/re_top.h                     re extension symbol hiding header
 ext/re/re.xs                   re extension external subroutines
 ext/re/t/regop.pl              generate debug output for various patterns
 ext/re/t/regop.t               test RE optimizations by scraping debug output
+ext/re/t/lexical_debug.pl      generate debug output for lexical re 'debug'
+ext/re/t/lexical_debug.t       test that lexical re 'debug' works
 ext/re/t/re.t                  see if re pragma works
 ext/Safe/t/safe1.t             See if Safe works
 ext/Safe/t/safe2.t             See if Safe works
index 170023c..6511797 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1362,7 +1362,9 @@ ERs       |bool   |reginclass     |NULLOK const regexp *prog|NN const regnode *n|NN const U8
 Es     |CHECKPOINT|regcppush   |I32 parenfloor
 Es     |char*  |regcppop       |NN const regexp *rex
 ERsn   |U8*    |reghop3        |NN U8 *pos|I32 off|NN const U8 *lim
+#ifdef XXX_dmq
 ERsn   |U8*    |reghop4        |NN U8 *pos|I32 off|NN const U8 *llim|NN const U8 *rlim
+#endif
 ERsn   |U8*    |reghopmaybe3   |NN U8 *pos|I32 off|NN const U8 *lim
 ERs    |char*  |find_byclass   |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK const regmatch_info *reginfo
 Es     |void   |to_utf8_substr |NN regexp * prog
diff --git a/embed.h b/embed.h
index 69ab33b..02f91a8 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define regcppush              S_regcppush
 #define regcppop               S_regcppop
 #define reghop3                        S_reghop3
+#endif
+#ifdef XXX_dmq
+#if defined(PERL_CORE) || defined(PERL_EXT)
 #define reghop4                        S_reghop4
+#endif
+#endif
+#if defined(PERL_CORE) || defined(PERL_EXT)
 #define reghopmaybe3           S_reghopmaybe3
 #define find_byclass           S_find_byclass
 #define to_utf8_substr         S_to_utf8_substr
 #define regcppush(a)           S_regcppush(aTHX_ a)
 #define regcppop(a)            S_regcppop(aTHX_ a)
 #define reghop3                        S_reghop3
+#endif
+#ifdef XXX_dmq
+#if defined(PERL_CORE) || defined(PERL_EXT)
 #define reghop4                        S_reghop4
+#endif
+#endif
+#if defined(PERL_CORE) || defined(PERL_EXT)
 #define reghopmaybe3           S_reghopmaybe3
 #define find_byclass(a,b,c,d,e)        S_find_byclass(aTHX_ a,b,c,d,e)
 #define to_utf8_substr(a)      S_to_utf8_substr(aTHX_ a)
index b387238..2aec5f0 100644 (file)
 #define PL_opsave              (vTHX->Topsave)
 #define PL_peepp               (vTHX->Tpeepp)
 #define PL_reg_state           (vTHX->Treg_state)
-#define PL_regcompp            (vTHX->Tregcompp)
 #define PL_regdummy            (vTHX->Tregdummy)
-#define PL_regdupe             (vTHX->Tregdupe)
-#define PL_regexecp            (vTHX->Tregexecp)
-#define PL_regfree             (vTHX->Tregfree)
-#define PL_regint_start                (vTHX->Tregint_start)
-#define PL_regint_string       (vTHX->Tregint_string)
 #define PL_reginterp_cnt       (vTHX->Treginterp_cnt)
 #define PL_regmatch_slab       (vTHX->Tregmatch_slab)
 #define PL_regmatch_state      (vTHX->Tregmatch_state)
 #define PL_Topsave             PL_opsave
 #define PL_Tpeepp              PL_peepp
 #define PL_Treg_state          PL_reg_state
-#define PL_Tregcompp           PL_regcompp
 #define PL_Tregdummy           PL_regdummy
-#define PL_Tregdupe            PL_regdupe
-#define PL_Tregexecp           PL_regexecp
-#define PL_Tregfree            PL_regfree
-#define PL_Tregint_start       PL_regint_start
-#define PL_Tregint_string      PL_regint_string
 #define PL_Treginterp_cnt      PL_reginterp_cnt
 #define PL_Tregmatch_slab      PL_regmatch_slab
 #define PL_Tregmatch_state     PL_regmatch_state
index ee262c6..9fab039 100644 (file)
@@ -215,6 +215,10 @@ sub setcolor {
   $colors =~ s/\0//g;
   $ENV{PERL_RE_COLORS} = $colors;
  };
+ if ($@) {
+    $ENV{PERL_RE_COLORS}||=qq'\t\t> <\t> <\t\t'
+ }
+                
 }
 
 my %flags = (
@@ -241,31 +245,34 @@ $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIE_MORE} | $flags{STATE};
 $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
 $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIE_COMPILE};
 
-my $installed = 0;
-
-sub _load_unload {
-    my $on = shift;
+my $installed =eval {
     require XSLoader;
     XSLoader::load('re');
-    install($on);
+    install();
+};
+
+sub _load_unload {
+    my ($on)= @_;
+    if ($on) {
+        die "'re' not installed!?" unless $installed;
+        #warn "installed: $installed\n";
+        install();  # allow for changes in colors
+        $^H{regcomp}= $installed;
+    } else {
+        delete $^H{regcomp};
+    }
 }
 
 sub bits {
     my $on = shift;
     my $bits = 0;
     unless (@_) {
-       require Carp;
-       Carp::carp("Useless use of \"re\" pragma");
+       return;
     }
     foreach my $idx (0..$#_){
         my $s=$_[$idx];
         if ($s eq 'Debug' or $s eq 'Debugcolor') {
-            if ($s eq 'Debugcolor') {
-                setcolor();     
-            } else {
-               # $ENV{PERL_RE_COLORS}||=qq'\t\t> <\t> <\t\t'
-            }
-            
+            setcolor() if $s =~/color/i;
             ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
             for my $idx ($idx+1..$#_) {
                 if ($flags{$_[$idx]}) {
@@ -283,7 +290,7 @@ sub bits {
             _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
             last;
         } elsif ($s eq 'debug' or $s eq 'debugcolor') {
-           setcolor() if $s eq 'debugcolor';
+           setcolor() if $s =~/color/i;
            _load_unload($on);
         } elsif (exists $bitmask{$s}) {
            $bits |= $bitmask{$s};
index 3433a0f..933296b 100644 (file)
@@ -7,6 +7,7 @@
 #include "perl.h"
 #include "XSUB.h"
 
+
 START_EXTERN_C
 
 extern regexp* my_regcomp (pTHX_ char* exp, char* xend, PMOP* pm);
@@ -19,104 +20,29 @@ extern char*       my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
                                    struct re_scream_pos_data_s *data);
 extern SV*     my_re_intuit_string (pTHX_ regexp *prog);
 
-extern regexp* my_regdupe (pTHX_ regexp *r, CLONE_PARAMS *param);
-
-
-END_EXTERN_C
-
-/* engine details need to be paired - non debugging, debuggin  */
-#define NEEDS_DEBUGGING 0x01
-struct regexp_engine {
-    regexp*    (*regcomp) (pTHX_ char* exp, char* xend, PMOP* pm);
-    I32                (*regexec) (pTHX_ regexp* prog, char* stringarg, char* strend,
-                           char* strbeg, I32 minend, SV* screamer,
-                           void* data, U32 flags);
-    char*      (*re_intuit_start) (pTHX_ regexp *prog, SV *sv, char *strpos,
-                                   char *strend, U32 flags,
-                                   struct re_scream_pos_data_s *data);
-    SV*                (*re_intuit_string) (pTHX_ regexp *prog);
-    void       (*regfree) (pTHX_ struct regexp* r);
 #if defined(USE_ITHREADS)
-    regexp*    (*regdupe) (pTHX_ regexp *r, CLONE_PARAMS *param);
+extern regexp* my_regdupe (pTHX_ const regexp *r, CLONE_PARAMS *param);
 #endif
-};
 
-struct regexp_engine engines[] = {
-    { Perl_pregcomp, Perl_regexec_flags, Perl_re_intuit_start,
-      Perl_re_intuit_string, Perl_pregfree
+const struct regexp_engine my_reg_engine = { 
+        my_regcomp, 
+        my_regexec, 
+        my_re_intuit_start, 
+        my_re_intuit_string, 
+        my_regfree, 
 #if defined(USE_ITHREADS)
-       , Perl_regdupe
+        my_regdupe 
 #endif
-    },
-    { my_regcomp, my_regexec, my_re_intuit_start, my_re_intuit_string,
-      my_regfree
-#if defined(USE_ITHREADS)
-      , my_regdupe
-#endif
-    }
 };
 
-#define MY_CXT_KEY "re::_guts" XS_VERSION
-
-typedef struct {
-    int                x_oldflag;              /* debug flag */
-    unsigned int x_state;
-} my_cxt_t;
-
-START_MY_CXT
-
-#define oldflag                (MY_CXT.x_oldflag)
-
-static void
-install(pTHX_ unsigned int new_state)
-{
-    dMY_CXT;
-    const unsigned int states 
-       = sizeof(engines) / sizeof(struct regexp_engine) -1;
-    if(new_state == MY_CXT.x_state)
-       return;
-
-    if (new_state > states) {
-       Perl_croak(aTHX_ "panic: re::install state %u is illegal - max is %u",
-                  new_state, states);
-    }
-
-    PL_regexecp = engines[new_state].regexec;
-    PL_regcompp = engines[new_state].regcomp;
-    PL_regint_start = engines[new_state].re_intuit_start;
-    PL_regint_string = engines[new_state].re_intuit_string;
-    PL_regfree = engines[new_state].regfree;
-#if defined(USE_ITHREADS)
-    PL_regdupe = engines[new_state].regdupe;
-#endif
-
-    if (new_state & NEEDS_DEBUGGING) {
-       PL_colorset = 0;        /* Allow reinspection of ENV. */
-       if (!(MY_CXT.x_state & NEEDS_DEBUGGING)) {
-           /* Debugging is turned on for the first time.  */
-           oldflag = PL_debug & DEBUG_r_FLAG;
-           PL_debug |= DEBUG_r_FLAG;
-       }
-    } else {
-       if (!(MY_CXT.x_state & NEEDS_DEBUGGING)) {
-           if (!oldflag)
-               PL_debug &= ~DEBUG_r_FLAG;
-       }
-    }
-
-    MY_CXT.x_state = new_state;
-}
+END_EXTERN_C
 
 MODULE = re    PACKAGE = re
 
-BOOT:
-{
-   MY_CXT_INIT;
-}
-
-
 void
-install(new_state)
-  unsigned int new_state;
-  CODE:
-    install(aTHX_ new_state);
+install()
+    PPCODE:
+        PL_colorset = 0;       /* Allow reinspection of ENV. */
+        /* PL_debug |= DEBUG_r_FLAG; */
+       XPUSHs(sv_2mortal(newSViv(PTR2IV(&my_reg_engine))));
+       
diff --git a/ext/re/t/lexical_debug.pl b/ext/re/t/lexical_debug.pl
new file mode 100644 (file)
index 0000000..c8b7c5b
--- /dev/null
@@ -0,0 +1,25 @@
+use re 'debug';
+
+$_ = 'foo bar baz bop fip fop';
+
+/foo/ and $count++;
+
+{
+    no re 'debug';
+    /bar/ and $count++;
+    {
+        use re 'debug';
+        /baz/ and $count++;
+    }
+    /bop/ and $count++;
+}
+
+/fip/ and $count++;
+
+no re 'debug';
+
+/fop/ and $count++;
+
+print "Count=$count\n";
+
+
diff --git a/ext/re/t/lexical_debug.t b/ext/re/t/lexical_debug.t
new file mode 100644 (file)
index 0000000..affa7c5
--- /dev/null
@@ -0,0 +1,30 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bre\b/) ){
+       print "1..0 # Skip -- Perl configured without re module\n";
+       exit 0;
+    }
+}
+
+use strict;
+require "./test.pl";
+my $out = runperl(progfile => "../ext/re/t/lexical_debug.pl", stderr => 1 );
+
+print "1..7\n";
+
+# Each pattern will produce an EXACT node with a specific string in 
+# it, so we will look for that. We can't just look for the string
+# alone as the string being matched against contains all of them.
+
+ok( $out =~ /EXACT <foo>/, "Expect 'foo'");
+ok( $out !~ /EXACT <bar>/, "No 'bar'");
+ok( $out =~ /EXACT <baz>/, "Expect 'baz'");
+ok( $out !~ /EXACT <bop>/, "No 'bop'");
+ok( $out =~ /EXACT <fip>/, "Expect 'fip'");
+ok( $out !~ /EXACT <fop>/, "No 'baz'");
+ok( $out =~ /Count=6\n/,"Count is 6");
+
index 5f09966..204092f 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 14;
+use Test::More tests => 13;
 require_ok( 're' );
 
 # setcolor
@@ -31,8 +31,8 @@ my $warn;
 local $SIG{__WARN__} = sub {
        $warn = shift;
 };
-eval { re::bits(1) };
-like( $warn, qr/Useless use/, 'bits() should warn with no args' );
+#eval { re::bits(1) };
+#like( $warn, qr/Useless use/, 'bits() should warn with no args' );
 
 delete $ENV{PERL_RE_COLORS};
 re::bits(0, 'debug');
@@ -65,7 +65,6 @@ my $ok='foo'=~/$reg/;
 eval"no re Debug=>'ALL'";
 ok( $ok, 'No segv!' );
 
-
 package Term::Cap;
 
 sub Tgetent {
diff --git a/op.c b/op.c
index 8872764..fbe455e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3225,7 +3225,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
         if (DO_UTF8(pat))
            pm->op_pmdynflags |= PMdf_UTF8;
        /* FIXME - can we make this function take const char * args?  */
-       PM_SETRE(pm, CALLREGCOMP(aTHX_ (char*)p, (char*)p + plen, pm));
+       PM_SETRE(pm, CALLREGCOMP((char*)p, (char*)p + plen, pm));
        if (strEQ("\\s+", PM_GETRE(pm)->precomp))
            pm->op_pmflags |= PMf_WHITE;
 #ifdef PERL_MAD
diff --git a/perl.h b/perl.h
index 81cf565..bc0b192 100644 (file)
--- a/perl.h
+++ b/perl.h
 #define CALL_FPTR(fptr) (*fptr)
 
 #define CALLRUNOPS  CALL_FPTR(PL_runops)
-#define CALLREGCOMP CALL_FPTR(PL_regcompp)
-#define CALLREGEXEC CALL_FPTR(PL_regexecp)
-#define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
-#define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
-#define CALLREGFREE CALL_FPTR(PL_regfree)
-#define CALLREGDUPE CALL_FPTR(PL_regdupe)
+
+#define CALLREGCOMP(exp, xend, pm) Perl_pregcomp(aTHX_ exp,xend,pm)
+
+#define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,screamer,data,flags) \
+    CALL_FPTR((prog)->engine->regexec)(aTHX_ (prog),(stringarg),(strend), \
+        (strbeg),(minend),(screamer),(data),(flags))
+#define CALLREG_INTUIT_START(prog,sv,strpos,strend,flags,data) \
+    CALL_FPTR((prog)->engine->re_intuit_start)(aTHX_ (prog), (sv), (strpos), \
+        (strend),(flags),(data))
+#define CALLREG_INTUIT_STRING(prog) \
+    CALL_FPTR((prog)->engine->re_intuit_string)(aTHX_ (prog))
+#define CALLREGFREE(prog) \
+    if(prog) CALL_FPTR((prog)->engine->regfree)(aTHX_ (prog))
+#if defined(USE_ITHREADS)         
+#define CALLREGDUPE(prog,param) \
+    (prog ? CALL_FPTR((prog)->engine->regdupe)(aTHX_ (prog),(param)) \
+          : (REGEXP *)NULL) 
+#endif
 
 /*
  * Because of backward compatibility reasons the PERL_UNUSED_DECL
@@ -3499,7 +3511,11 @@ Gid_t getegid (void);
        } STMT_END
 
 #  define DEBUG_f(a) DEBUG__(DEBUG_f_TEST, a)
+#ifndef PERL_EXT_RE_BUILD
 #  define DEBUG_r(a) DEBUG__(DEBUG_r_TEST, a)
+#else
+#  define DEBUG_r(a) STMT_START {a;} STMT_END
+#endif /* PERL_EXT_RE_BUILD */
 #  define DEBUG_x(a) DEBUG__(DEBUG_x_TEST, a)
 #  define DEBUG_u(a) DEBUG__(DEBUG_u_TEST, a)
 #  define DEBUG_H(a) DEBUG__(DEBUG_H_TEST, a)
index f5b8d12..4af49dc 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -784,20 +784,8 @@ END_EXTERN_C
 #define PL_peepp               (*Perl_Tpeepp_ptr(aTHX))
 #undef  PL_reg_state
 #define PL_reg_state           (*Perl_Treg_state_ptr(aTHX))
-#undef  PL_regcompp
-#define PL_regcompp            (*Perl_Tregcompp_ptr(aTHX))
 #undef  PL_regdummy
 #define PL_regdummy            (*Perl_Tregdummy_ptr(aTHX))
-#undef  PL_regdupe
-#define PL_regdupe             (*Perl_Tregdupe_ptr(aTHX))
-#undef  PL_regexecp
-#define PL_regexecp            (*Perl_Tregexecp_ptr(aTHX))
-#undef  PL_regfree
-#define PL_regfree             (*Perl_Tregfree_ptr(aTHX))
-#undef  PL_regint_start
-#define PL_regint_start                (*Perl_Tregint_start_ptr(aTHX))
-#undef  PL_regint_string
-#define PL_regint_string       (*Perl_Tregint_string_ptr(aTHX))
 #undef  PL_reginterp_cnt
 #define PL_reginterp_cnt       (*Perl_Treginterp_cnt_ptr(aTHX))
 #undef  PL_regmatch_slab
diff --git a/pp.c b/pp.c
index 6809b31..25279a3 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4638,7 +4638,7 @@ PP(pp_split)
             && (rx->reganch & ROPT_CHECK_ALL)
             && !(rx->reganch & ROPT_ANCH)) {
        const int tail = (rx->reganch & RE_INTUIT_TAIL);
-       SV * const csv = CALLREG_INTUIT_STRING(aTHX_ rx);
+       SV * const csv = CALLREG_INTUIT_STRING(rx);
 
        len = rx->minlen;
        if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
@@ -4688,7 +4688,7 @@ PP(pp_split)
        {
            I32 rex_return;
            PUTBACK;
-           rex_return = CALLREGEXEC(aTHX_ rx, (char*)s, (char*)strend, (char*)orig, 1 ,
+           rex_return = CALLREGEXEC(rx, (char*)s, (char*)strend, (char*)orig, 1 ,
                            sv, NULL, 0);
            SPAGAIN;
            if (rex_return == 0)
index c1df86e..cda9811 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -146,7 +146,7 @@ PP(pp_regcomp)
                if (pm->op_pmdynflags & PMdf_UTF8)
                    t = (char*)bytes_to_utf8((U8*)t, &len);
            }
-           PM_SETRE(pm, CALLREGCOMP(aTHX_ (char *)t, (char *)t + len, pm));
+           PM_SETRE(pm, CALLREGCOMP((char *)t, (char *)t + len, pm));
            if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
                Safefree(t);
            PL_reginterp_cnt = 0;       /* XXXX Be extra paranoid - needed
@@ -214,7 +214,7 @@ PP(pp_substcont)
        FREETMPS; /* Prevent excess tmp stack */
 
        /* Are we done */
-       if (cx->sb_once || !CALLREGEXEC(aTHX_ rx, s, cx->sb_strend, orig,
+       if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
                                     s == m, cx->sb_targ, NULL,
                                     ((cx->sb_rflags & REXEC_COPY_STR)
                                      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
index 32274ff..be69c99 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1371,7 +1371,7 @@ play_it_again:
        DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) {
        /* FIXME - can PL_bostr be made const char *?  */
        PL_bostr = (char *)truebase;
-       s = CALLREG_INTUIT_START(aTHX_ rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
+       s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
 
        if (!s)
            goto nope;
@@ -1383,7 +1383,7 @@ play_it_again:
             && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
            goto yup;
     }
-    if (CALLREGEXEC(aTHX_ rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, NULL, r_flags))
+    if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, NULL, r_flags))
     {
        PL_curpm = pm;
        if (dynpm->op_pmflags & PMf_ONCE)
@@ -2139,7 +2139,7 @@ PP(pp_subst)
     orig = m = s;
     if (rx->reganch & RE_USE_INTUIT) {
        PL_bostr = orig;
-       s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
+       s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
 
        if (!s)
            goto nope;
@@ -2187,7 +2187,7 @@ PP(pp_subst)
        && (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
        && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)
        && (!doutf8 || SvUTF8(TARG))) {
-       if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
+       if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
                         r_flags | REXEC_CHECKED))
        {
            SPAGAIN;
@@ -2265,7 +2265,7 @@ PP(pp_subst)
                    d += clen;
                }
                s = rx->endp[0] + orig;
-           } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
+           } while (CALLREGEXEC(rx, s, strend, orig, s == m,
                                 TARG, NULL,
                                 /* don't match same null twice */
                                 REXEC_NOT_FIRST|REXEC_IGNOREPOS));
@@ -2292,7 +2292,7 @@ PP(pp_subst)
        RETURN;
     }
 
-    if (CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
+    if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
                    r_flags | REXEC_CHECKED))
     {
        if (force_on_match) {
@@ -2337,7 +2337,7 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
+       } while (CALLREGEXEC(rx, s, strend, orig, s == m,
                             TARG, NULL, r_flags));
        if (doutf8 && !DO_UTF8(TARG))
            sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
diff --git a/proto.h b/proto.h
index 2f6045d..2a727e9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3718,12 +3718,14 @@ STATIC U8*      S_reghop3(U8 *pos, I32 off, const U8 *lim)
                        __attribute__nonnull__(1)
                        __attribute__nonnull__(3);
 
+#ifdef XXX_dmq
 STATIC U8*     S_reghop4(U8 *pos, I32 off, const U8 *llim, const U8 *rlim)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(1)
                        __attribute__nonnull__(3)
                        __attribute__nonnull__(4);
 
+#endif
 STATIC U8*     S_reghopmaybe3(U8 *pos, I32 off, const U8 *lim)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(1)
index 62e0a91..1a7c08e 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -3669,6 +3669,7 @@ Perl_reginitcolors(pTHX)
 #else
 #define CHECK_RESTUDY_GOTO
 #endif        
+
 /*
  - pregcomp - compile a regular expression into internal code
  *
@@ -3684,10 +3685,37 @@ Perl_reginitcolors(pTHX)
  * Beware that the optimization-preparation code in here knows about some
  * of the structure of the compiled regexp.  [I'll say.]
  */
+#ifndef PERL_IN_XSUB_RE
+#define CORE_ONLY_BLOCK(c) {c}{
+#define RE_ENGINE_PTR &PL_core_reg_engine
+#else
+#define CORE_ONLY_BLOCK(c) {
+extern const struct regexp_engine my_reg_engine;
+#define RE_ENGINE_PTR &my_reg_engine
+#endif
+#define END_BLOCK }
 regexp *
 Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
 {
     dVAR;
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_r(if (!PL_colorset) reginitcolors());
+    CORE_ONLY_BLOCK(
+    /* Dispatch a request to compile a regexp to correct 
+       regexp engine. */
+    HV * const table = GvHV(PL_hintgv);
+    if (table) {
+        SV **ptr= hv_fetchs(table, "regcomp", FALSE);
+        if (ptr && SvIOK(*ptr)) {
+            const regexp_engine *eng=INT2PTR(regexp_engine*,SvIV(*ptr));
+            DEBUG_COMPILE_r({
+                PerlIO_printf(Perl_debug_log, "Using engine %"IVxf"\n",
+                    SvIV(*ptr));
+            });            
+            return CALL_FPTR((eng->regcomp))(aTHX_ exp, xend, pm);
+        } 
+    })
     register regexp *r;
     regnode *scan;
     regnode *first;
@@ -3702,16 +3730,12 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     int restudied= 0;
     RExC_state_t copyRExC_state;
 #endif    
-
-    GET_RE_DEBUG_FLAGS_DECL;
-
     if (exp == NULL)
        FAIL("NULL regexp argument");
 
     RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
 
     RExC_precomp = exp;
-    DEBUG_r(if (!PL_colorset) reginitcolors());
     DEBUG_COMPILE_r({
         SV *dsv= sv_newmortal();
         RE_PV_QUOTED_DECL(s, RExC_utf8,
@@ -3765,16 +3789,19 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     if (RExC_whilem_seen > 15)
        RExC_whilem_seen = 15;
 
-    /* Allocate space and initialize. */
+    /* Allocate space and zero-initialize. Note, the two step process 
+       of zeroing when in debug mode, thus anything assigned has to 
+       happen after that */
     Newxc(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode),
         char, regexp);
     if (r == NULL)
        FAIL("Regexp out of space");
-
 #ifdef DEBUGGING
     /* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
     Zero(r, sizeof(regexp) + (unsigned)RExC_size * sizeof(regnode), char);
 #endif
+    /* initialization begins here */
+    r->engine= RE_ENGINE_PTR;
     r->refcnt = 1;
     r->prelen = xend - exp;
     r->precomp = savepvn(RExC_precomp, r->prelen);
@@ -4209,6 +4236,8 @@ reStudy:
        r->reganch |= ROPT_CANY_SEEN;
     Newxz(r->startp, RExC_npar, I32);
     Newxz(r->endp, RExC_npar, I32);
+    
+    
     if (RExC_charnames) 
         SvREFCNT_dec((SV*)(RExC_charnames));
 
@@ -4230,8 +4259,12 @@ reStudy:
         PerlIO_printf(Perl_debug_log, "\n");
     });
     return(r);
+    END_BLOCK    
 }
 
+#undef CORE_ONLY_BLOCK
+#undef END_BLOCK
+#undef RE_ENGINE_PTR
 
 #define DEBUG_PARSE_MSG(funcname)     DEBUG_PARSE_r({           \
     int rem=(int)(RExC_end - RExC_parse);                       \
@@ -7676,7 +7709,6 @@ Perl_pregfree(pTHX_ struct regexp *r)
    
    See pregfree() above if you change anything here. 
 */
-       
 #if defined(USE_ITHREADS)
 regexp *
 Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param)
@@ -7792,6 +7824,8 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param)
 
     ret->sublen         = r->sublen;
 
+    ret->engine         = r->engine;
+
     if (RX_MATCH_COPIED(ret))
        ret->subbeg  = SAVEPVN(r->subbeg, r->sublen);
     else
@@ -7802,7 +7836,6 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param)
 
     ptr_table_store(PL_ptr_table, r, ret);
     return ret;
-    return NULL;    
 }
 #endif    
 
index b4f549f..a3dc5d6 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
@@ -364,13 +364,26 @@ EXTCONST U8 PL_simple[] = {
 };
 #endif
 
+#ifndef PLUGGABLE_RE_EXTENSION
+#ifndef DOINIT
+EXTCONST regexp_engine PL_core_reg_engine;
+#else /* DOINIT */
+EXTCONST regexp_engine PL_core_reg_engine = { 
+        Perl_pregcomp, 
+        Perl_regexec_flags, 
+        Perl_re_intuit_start,
+        Perl_re_intuit_string, 
+        Perl_pregfree, 
+#if defined(USE_ITHREADS)        
+        Perl_regdupe 
+#endif        
+};
+#endif /* DOINIT */
+#endif /* PLUGGABLE_RE_EXTENSION */
+
+
 END_EXTERN_C
 
-typedef struct re_scream_pos_data_s
-{
-    char **scream_olds;                /* match pos */
-    I32 *scream_pos;           /* Internal iterator of scream. */
-} re_scream_pos_data;
 
 /* .what is a character array with one character for each member of .data
  * The character describes the function of the corresponding .data item:
index bfea6e2..2884971 100644 (file)
@@ -86,12 +86,14 @@ printf OUT <<EOP,
 #define %*s\t%d
 
 EOP
--$width,REGNODE_MAX=>$lastregop-1,-$width,REGMATCH_STATE_MAX=>$tot-1;
+    -$width, REGNODE_MAX        => $lastregop - 1,
+    -$width, REGMATCH_STATE_MAX => $tot - 1
+;
 
 $ind = 0;
 while (++$ind <= $tot) {
   my $oind = $ind - 1;
-  printf OUT "#define\t%*s\t%d\t/*%#04x %s*/\n",
+  printf OUT "#define\t%*s\t%d\t/* %#04x %s */\n",
     -$width, $name[$ind], $ind-1, $ind-1, $rest[$ind];
   print OUT "\n\t/* ------------ States ------------- */\n\n"
     if $ind == $lastregop and $lastregop != $tot;
@@ -150,7 +152,7 @@ print OUT <<EOP;
 };
 
 #ifdef DEBUGGING
-extern const char * const reg_name[] = {
+const char * const reg_name[] = {
 EOP
 
 $ind = 0;
index 96b84eb..34fd8a0 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -1637,7 +1637,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     I32 scream_pos = -1;               /* Internal iterator of scream. */
     char *scream_olds = NULL;
     SV* const oreplsv = GvSV(PL_replgv);
-    const bool do_utf8 = DO_UTF8(sv);
+    const bool do_utf8 = (bool)DO_UTF8(sv);
     I32 multiline;
 
     regmatch_info reginfo;  /* create some info to pass to regtry etc */
@@ -1773,7 +1773,11 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            }
        }
        goto phooey;
-    } else if (prog->reganch & ROPT_ANCH_GPOS) {
+    } else if (ROPT_GPOS_CHECK == (prog->reganch & ROPT_GPOS_CHECK)) 
+    {
+        /* the warning about reginfo.ganch being used without intialization
+           is bogus -- we set it above, when prog->reganch & ROPT_GPOS_SEEN 
+           and we only enter this block when the same bit is set. */
        if (regtry(&reginfo, reginfo.ganch))
            goto got_it;
        goto phooey;
@@ -2203,13 +2207,13 @@ S_regtry(pTHX_ const regmatch_info *reginfo, char *startpos)
 #define sayNO_SILENT goto do_no
 #define saySAME(x) if (x) goto yes; else goto no
 
-#define CACHEsayNO STMT_START { \
+/* we dont use STMT_START/END here because it leads to 
+   "unreachable code" warnings, which are bogus, but distracting. */
+#define CACHEsayNO \
     if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) \
        PL_reg_poscache[st->u.whilem.cache_offset] |= \
            (1<<st->u.whilem.cache_bit); \
-    sayNO; \
-} STMT_END
-
+    sayNO
 
 /* this is used to determine how far from the left messages like
    'failed...' are printed. It should be set such that messages 
@@ -2472,7 +2476,7 @@ S_dump_exec_pos(pTHX_ const char *locinput,
                    len1, s1,
                    (docolor ? "" : "> <"),
                    len2, s2,
-                   tlen > 19 ? 0 :  19 - tlen,
+                   (int)(tlen > 19 ? 0 :  19 - tlen),
                    "");
     }
 }
@@ -2715,7 +2719,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
                while ( state && uc <= (U8*)PL_regeol ) {
                     U32 base = trie->states[ state ].trans.base;
-                    UV uvc;
+                    UV uvc = 0;
                     U16 charid;
                     /* We use charid to hold the wordnum as we don't use it
                        for charid until after we have done the wordnum logic. 
@@ -3389,7 +3393,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
                        Zero(&pm, 1, PMOP);
                        if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
-                       re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
+                       re = CALLREGCOMP((char*)t, (char*)t + len, &pm);
                        if (!(SvFLAGS(ret)
                              & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
                                | SVs_GMG)))
@@ -3434,7 +3438,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                /* NOTREACHED */
            }
            /* /(?(?{...})X|Y)/ */
-           st->sw = SvTRUE(ret);
+           st->sw = (bool)SvTRUE(ret);
            st->logical = 0;
            break;
        }
@@ -3484,7 +3488,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
            break;
        case GROUPP:
            n = ARG(scan);  /* which paren pair */
-           st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
+           st->sw = (bool)((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
            break;
        case IFTHEN:
            PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
@@ -5178,6 +5182,11 @@ S_reghop3(U8 *s, I32 off, const U8* lim)
     return s;
 }
 
+#ifdef XXX_dmq
+/* there are a bunch of places where we use two reghop3's that should
+   be replaced with this routine. but since thats not done yet 
+   we ifdef it out - dmq
+*/
 STATIC U8 *
 S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
 {
@@ -5200,7 +5209,7 @@ S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
     }
     return s;
 }
-
+#endif
 
 STATIC U8 *
 S_reghopmaybe3(U8* s, I32 off, const U8* lim)
index 263ccfa..09759fa 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -30,6 +30,8 @@ struct reg_substr_data;
 
 struct reg_data;
 
+struct regexp_engine;
+
 typedef struct regexp {
        I32 *startp;
        I32 *endp;
@@ -52,9 +54,32 @@ typedef struct regexp {
        U32 lastcloseparen;     /* last paren matched */
        U32 reganch;            /* Internal use only +
                                   Tainted information used by regexec? */
+        const struct regexp_engine* engine;
        regnode program[1];     /* Unwarranted chumminess with compiler. */
 } regexp;
 
+
+typedef struct re_scream_pos_data_s
+{
+    char **scream_olds;                /* match pos */
+    I32 *scream_pos;           /* Internal iterator of scream. */
+} re_scream_pos_data;
+
+typedef struct regexp_engine {
+    regexp*    (*regcomp) (pTHX_ char* exp, char* xend, PMOP* pm);
+    I32                (*regexec) (pTHX_ regexp* prog, char* stringarg, char* strend,
+                           char* strbeg, I32 minend, SV* screamer,
+                           void* data, U32 flags);
+    char*      (*re_intuit_start) (pTHX_ regexp *prog, SV *sv, char *strpos,
+                                   char *strend, U32 flags,
+                                   struct re_scream_pos_data_s *data);
+    SV*                (*re_intuit_string) (pTHX_ regexp *prog);
+    void       (*regfree) (pTHX_ struct regexp* r);
+#if defined(USE_ITHREADS)
+    regexp*    (*regdupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
+#endif    
+} regexp_engine;
+
 #define ROPT_ANCH              (ROPT_ANCH_BOL|ROPT_ANCH_MBOL|ROPT_ANCH_GPOS|ROPT_ANCH_SBOL)
 #define ROPT_ANCH_SINGLE       (ROPT_ANCH_SBOL|ROPT_ANCH_GPOS)
 #define ROPT_ANCH_BOL          0x00000001
@@ -70,6 +95,7 @@ typedef struct regexp {
 #define ROPT_EVAL_SEEN         0x00000400
 #define ROPT_CANY_SEEN         0x00000800
 #define ROPT_SANY_SEEN         ROPT_CANY_SEEN /* src bckwrd cmpt */
+#define ROPT_GPOS_CHECK         (ROPT_GPOS_SEEN|ROPT_ANCH_GPOS)
 
 /* 0xf800 of reganch is used by PMf_COMPILETIME */
 
@@ -106,6 +132,7 @@ typedef struct regexp {
 #define RX_MATCH_COPIED_set(prog,t)    ((t) \
                                         ? RX_MATCH_COPIED_on(prog) \
                                         : RX_MATCH_COPIED_off(prog))
+
 #endif /* PLUGGABLE_RE_EXTENSION */
 
 /* Stuff that needs to be included in the plugable extension goes below here */
@@ -145,7 +172,7 @@ typedef struct regexp {
 #define REXEC_NOT_FIRST        0x10            /* This is another iteration of //g. */
 
 #define ReREFCNT_inc(re) ((void)(re && re->refcnt++), re)
-#define ReREFCNT_dec(re) CALLREGFREE(aTHX_ re)
+#define ReREFCNT_dec(re) CALLREGFREE(re)
 
 #define FBMcf_TAIL_DOLLAR      1
 #define FBMcf_TAIL_DOLLARM     2
index b967287..31286f9 100644 (file)
 #define REGNODE_MAX            66
 #define REGMATCH_STATE_MAX     91
 
-#define        END                     0       /*0000 End of program.*/
-#define        SUCCEED                 1       /*0x01 Return from a subroutine, basically.*/
-#define        BOL                     2       /*0x02 Match "" at beginning of line.*/
-#define        MBOL                    3       /*0x03 Same, assuming multiline.*/
-#define        SBOL                    4       /*0x04 Same, assuming singleline.*/
-#define        EOS                     5       /*0x05 Match "" at end of string.*/
-#define        EOL                     6       /*0x06 Match "" at end of line.*/
-#define        MEOL                    7       /*0x07 Same, assuming multiline.*/
-#define        SEOL                    8       /*0x08 Same, assuming singleline.*/
-#define        BOUND                   9       /*0x09 Match "" at any word boundary*/
-#define        BOUNDL                  10      /*0x0a Match "" at any word boundary*/
-#define        NBOUND                  11      /*0x0b Match "" at any word non-boundary*/
-#define        NBOUNDL                 12      /*0x0c Match "" at any word non-boundary*/
-#define        GPOS                    13      /*0x0d Matches where last m//g left off.*/
-#define        REG_ANY                 14      /*0x0e Match any one character (except newline).*/
-#define        SANY                    15      /*0x0f Match any one character.*/
-#define        CANY                    16      /*0x10 Match any one byte.*/
-#define        ANYOF                   17      /*0x11 Match character in (or not in) this class.*/
-#define        ALNUM                   18      /*0x12 Match any alphanumeric character*/
-#define        ALNUML                  19      /*0x13 Match any alphanumeric char in locale*/
-#define        NALNUM                  20      /*0x14 Match any non-alphanumeric character*/
-#define        NALNUML                 21      /*0x15 Match any non-alphanumeric char in locale*/
-#define        SPACE                   22      /*0x16 Match any whitespace character*/
-#define        SPACEL                  23      /*0x17 Match any whitespace char in locale*/
-#define        NSPACE                  24      /*0x18 Match any non-whitespace character*/
-#define        NSPACEL                 25      /*0x19 Match any non-whitespace char in locale*/
-#define        DIGIT                   26      /*0x1a Match any numeric character*/
-#define        DIGITL                  27      /*0x1b Match any numeric character in locale*/
-#define        NDIGIT                  28      /*0x1c Match any non-numeric character*/
-#define        NDIGITL                 29      /*0x1d Match any non-numeric character in locale*/
-#define        CLUMP                   30      /*0x1e Match any combining character sequence*/
-#define        BRANCH                  31      /*0x1f Match this alternative, or the next...*/
-#define        BACK                    32      /*0x20 Match "", "next" ptr points backward.*/
-#define        EXACT                   33      /*0x21 Match this string (preceded by length).*/
-#define        EXACTF                  34      /*0x22 Match this string, folded (prec. by length).*/
-#define        EXACTFL                 35      /*0x23 Match this string, folded in locale (w/len).*/
-#define        NOTHING                 36      /*0x24 Match empty string.*/
-#define        TAIL                    37      /*0x25 Match empty string. Can jump here from outside.*/
-#define        STAR                    38      /*0x26 Match this (simple) thing 0 or more times.*/
-#define        PLUS                    39      /*0x27 Match this (simple) thing 1 or more times.*/
-#define        CURLY                   40      /*0x28 Match this simple thing {n,m} times.*/
-#define        CURLYN                  41      /*0x29 Match next-after-this simple thing*/
-#define        CURLYM                  42      /*0x2a Match this medium-complex thing {n,m} times.*/
-#define        CURLYX                  43      /*0x2b Match this complex thing {n,m} times.*/
-#define        WHILEM                  44      /*0x2c Do curly processing and see if rest matches.*/
-#define        OPEN                    45      /*0x2d Mark this point in input as start of*/
-#define        CLOSE                   46      /*0x2e Analogous to OPEN.*/
-#define        REF                     47      /*0x2f Match some already matched string*/
-#define        REFF                    48      /*0x30 Match already matched string, folded*/
-#define        REFFL                   49      /*0x31 Match already matched string, folded in loc.*/
-#define        IFMATCH                 50      /*0x32 Succeeds if the following matches.*/
-#define        UNLESSM                 51      /*0x33 Fails if the following matches.*/
-#define        SUSPEND                 52      /*0x34 "Independent" sub-RE.*/
-#define        IFTHEN                  53      /*0x35 Switch, should be preceeded by switcher .*/
-#define        GROUPP                  54      /*0x36 Whether the group matched.*/
-#define        LONGJMP                 55      /*0x37 Jump far away.*/
-#define        BRANCHJ                 56      /*0x38 BRANCH with long offset.*/
-#define        EVAL                    57      /*0x39 Execute some Perl code.*/
-#define        MINMOD                  58      /*0x3a Next operator is not greedy.*/
-#define        LOGICAL                 59      /*0x3b Next opcode should set the flag only.*/
-#define        RENUM                   60      /*0x3c Group with independently numbered parens.*/
-#define        TRIE                    61      /*0x3d Match many EXACT(FL?)? at once. flags==type*/
-#define        TRIEC                   62      /*0x3e Same as TRIE, but with embedded charclass data*/
-#define        AHOCORASICK             63      /*0x3f Aho Corasick stclass. flags==type*/
-#define        AHOCORASICKC            64      /*0x40 Same as AHOCORASICK, but with embedded charclass data*/
-#define        OPTIMIZED               65      /*0x41 Placeholder for dump.*/
-#define        PSEUDO                  66      /*0x42 Pseudo opcode for internal use.*/
+#define        END                     0       /* 0000 End of program. */
+#define        SUCCEED                 1       /* 0x01 Return from a subroutine, basically. */
+#define        BOL                     2       /* 0x02 Match "" at beginning of line. */
+#define        MBOL                    3       /* 0x03 Same, assuming multiline. */
+#define        SBOL                    4       /* 0x04 Same, assuming singleline. */
+#define        EOS                     5       /* 0x05 Match "" at end of string. */
+#define        EOL                     6       /* 0x06 Match "" at end of line. */
+#define        MEOL                    7       /* 0x07 Same, assuming multiline. */
+#define        SEOL                    8       /* 0x08 Same, assuming singleline. */
+#define        BOUND                   9       /* 0x09 Match "" at any word boundary */
+#define        BOUNDL                  10      /* 0x0a Match "" at any word boundary */
+#define        NBOUND                  11      /* 0x0b Match "" at any word non-boundary */
+#define        NBOUNDL                 12      /* 0x0c Match "" at any word non-boundary */
+#define        GPOS                    13      /* 0x0d Matches where last m//g left off. */
+#define        REG_ANY                 14      /* 0x0e Match any one character (except newline). */
+#define        SANY                    15      /* 0x0f Match any one character. */
+#define        CANY                    16      /* 0x10 Match any one byte. */
+#define        ANYOF                   17      /* 0x11 Match character in (or not in) this class. */
+#define        ALNUM                   18      /* 0x12 Match any alphanumeric character */
+#define        ALNUML                  19      /* 0x13 Match any alphanumeric char in locale */
+#define        NALNUM                  20      /* 0x14 Match any non-alphanumeric character */
+#define        NALNUML                 21      /* 0x15 Match any non-alphanumeric char in locale */
+#define        SPACE                   22      /* 0x16 Match any whitespace character */
+#define        SPACEL                  23      /* 0x17 Match any whitespace char in locale */
+#define        NSPACE                  24      /* 0x18 Match any non-whitespace character */
+#define        NSPACEL                 25      /* 0x19 Match any non-whitespace char in locale */
+#define        DIGIT                   26      /* 0x1a Match any numeric character */
+#define        DIGITL                  27      /* 0x1b Match any numeric character in locale */
+#define        NDIGIT                  28      /* 0x1c Match any non-numeric character */
+#define        NDIGITL                 29      /* 0x1d Match any non-numeric character in locale */
+#define        CLUMP                   30      /* 0x1e Match any combining character sequence */
+#define        BRANCH                  31      /* 0x1f Match this alternative, or the next... */
+#define        BACK                    32      /* 0x20 Match "", "next" ptr points backward. */
+#define        EXACT                   33      /* 0x21 Match this string (preceded by length). */
+#define        EXACTF                  34      /* 0x22 Match this string, folded (prec. by length). */
+#define        EXACTFL                 35      /* 0x23 Match this string, folded in locale (w/len). */
+#define        NOTHING                 36      /* 0x24 Match empty string. */
+#define        TAIL                    37      /* 0x25 Match empty string. Can jump here from outside. */
+#define        STAR                    38      /* 0x26 Match this (simple) thing 0 or more times. */
+#define        PLUS                    39      /* 0x27 Match this (simple) thing 1 or more times. */
+#define        CURLY                   40      /* 0x28 Match this simple thing {n,m} times. */
+#define        CURLYN                  41      /* 0x29 Match next-after-this simple thing */
+#define        CURLYM                  42      /* 0x2a Match this medium-complex thing {n,m} times. */
+#define        CURLYX                  43      /* 0x2b Match this complex thing {n,m} times. */
+#define        WHILEM                  44      /* 0x2c Do curly processing and see if rest matches. */
+#define        OPEN                    45      /* 0x2d Mark this point in input as start of */
+#define        CLOSE                   46      /* 0x2e Analogous to OPEN. */
+#define        REF                     47      /* 0x2f Match some already matched string */
+#define        REFF                    48      /* 0x30 Match already matched string, folded */
+#define        REFFL                   49      /* 0x31 Match already matched string, folded in loc. */
+#define        IFMATCH                 50      /* 0x32 Succeeds if the following matches. */
+#define        UNLESSM                 51      /* 0x33 Fails if the following matches. */
+#define        SUSPEND                 52      /* 0x34 "Independent" sub-RE. */
+#define        IFTHEN                  53      /* 0x35 Switch, should be preceeded by switcher . */
+#define        GROUPP                  54      /* 0x36 Whether the group matched. */
+#define        LONGJMP                 55      /* 0x37 Jump far away. */
+#define        BRANCHJ                 56      /* 0x38 BRANCH with long offset. */
+#define        EVAL                    57      /* 0x39 Execute some Perl code. */
+#define        MINMOD                  58      /* 0x3a Next operator is not greedy. */
+#define        LOGICAL                 59      /* 0x3b Next opcode should set the flag only. */
+#define        RENUM                   60      /* 0x3c Group with independently numbered parens. */
+#define        TRIE                    61      /* 0x3d Match many EXACT(FL?)? at once. flags==type */
+#define        TRIEC                   62      /* 0x3e Same as TRIE, but with embedded charclass data */
+#define        AHOCORASICK             63      /* 0x3f Aho Corasick stclass. flags==type */
+#define        AHOCORASICKC            64      /* 0x40 Same as AHOCORASICK, but with embedded charclass data */
+#define        OPTIMIZED               65      /* 0x41 Placeholder for dump. */
+#define        PSEUDO                  66      /* 0x42 Pseudo opcode for internal use. */
 
        /* ------------ States ------------- */
 
-#define        TRIE_next               67      /*0x43 Regmatch state for TRIE*/
-#define        TRIE_next_fail          68      /*0x44 Regmatch state for TRIE*/
-#define        EVAL_AB                 69      /*0x45 Regmatch state for EVAL*/
-#define        EVAL_AB_fail            70      /*0x46 Regmatch state for EVAL*/
-#define        resume_CURLYX           71      /*0x47 Regmatch state for CURLYX*/
-#define        resume_WHILEM1          72      /*0x48 Regmatch state for WHILEM*/
-#define        resume_WHILEM2          73      /*0x49 Regmatch state for WHILEM*/
-#define        resume_WHILEM3          74      /*0x4a Regmatch state for WHILEM*/
-#define        resume_WHILEM4          75      /*0x4b Regmatch state for WHILEM*/
-#define        resume_WHILEM5          76      /*0x4c Regmatch state for WHILEM*/
-#define        resume_WHILEM6          77      /*0x4d Regmatch state for WHILEM*/
-#define        BRANCH_next             78      /*0x4e Regmatch state for BRANCH*/
-#define        BRANCH_next_fail        79      /*0x4f Regmatch state for BRANCH*/
-#define        CURLYM_A                80      /*0x50 Regmatch state for CURLYM*/
-#define        CURLYM_A_fail           81      /*0x51 Regmatch state for CURLYM*/
-#define        CURLYM_B                82      /*0x52 Regmatch state for CURLYM*/
-#define        CURLYM_B_fail           83      /*0x53 Regmatch state for CURLYM*/
-#define        IFMATCH_A               84      /*0x54 Regmatch state for IFMATCH*/
-#define        IFMATCH_A_fail          85      /*0x55 Regmatch state for IFMATCH*/
-#define        CURLY_B_min_known       86      /*0x56 Regmatch state for CURLY*/
-#define        CURLY_B_min_known_fail  87      /*0x57 Regmatch state for CURLY*/
-#define        CURLY_B_min             88      /*0x58 Regmatch state for CURLY*/
-#define        CURLY_B_min_fail        89      /*0x59 Regmatch state for CURLY*/
-#define        CURLY_B_max             90      /*0x5a Regmatch state for CURLY*/
-#define        CURLY_B_max_fail        91      /*0x5b Regmatch state for CURLY*/
+#define        TRIE_next               67      /* 0x43 Regmatch state for TRIE */
+#define        TRIE_next_fail          68      /* 0x44 Regmatch state for TRIE */
+#define        EVAL_AB                 69      /* 0x45 Regmatch state for EVAL */
+#define        EVAL_AB_fail            70      /* 0x46 Regmatch state for EVAL */
+#define        resume_CURLYX           71      /* 0x47 Regmatch state for CURLYX */
+#define        resume_WHILEM1          72      /* 0x48 Regmatch state for WHILEM */
+#define        resume_WHILEM2          73      /* 0x49 Regmatch state for WHILEM */
+#define        resume_WHILEM3          74      /* 0x4a Regmatch state for WHILEM */
+#define        resume_WHILEM4          75      /* 0x4b Regmatch state for WHILEM */
+#define        resume_WHILEM5          76      /* 0x4c Regmatch state for WHILEM */
+#define        resume_WHILEM6          77      /* 0x4d Regmatch state for WHILEM */
+#define        BRANCH_next             78      /* 0x4e Regmatch state for BRANCH */
+#define        BRANCH_next_fail        79      /* 0x4f Regmatch state for BRANCH */
+#define        CURLYM_A                80      /* 0x50 Regmatch state for CURLYM */
+#define        CURLYM_A_fail           81      /* 0x51 Regmatch state for CURLYM */
+#define        CURLYM_B                82      /* 0x52 Regmatch state for CURLYM */
+#define        CURLYM_B_fail           83      /* 0x53 Regmatch state for CURLYM */
+#define        IFMATCH_A               84      /* 0x54 Regmatch state for IFMATCH */
+#define        IFMATCH_A_fail          85      /* 0x55 Regmatch state for IFMATCH */
+#define        CURLY_B_min_known       86      /* 0x56 Regmatch state for CURLY */
+#define        CURLY_B_min_known_fail  87      /* 0x57 Regmatch state for CURLY */
+#define        CURLY_B_min             88      /* 0x58 Regmatch state for CURLY */
+#define        CURLY_B_min_fail        89      /* 0x59 Regmatch state for CURLY */
+#define        CURLY_B_max             90      /* 0x5a Regmatch state for CURLY */
+#define        CURLY_B_max_fail        91      /* 0x5b Regmatch state for CURLY */
 
 
 #ifndef DOINIT
@@ -347,7 +347,7 @@ static const char reg_off_by_arg[] = {
 };
 
 #ifdef DEBUGGING
-extern const char * const reg_name[] = {
+const char * const reg_name[] = {
        "END",                          /* 0000 */
        "SUCCEED",                      /* 0x01 */
        "BOL",                          /* 0x02 */
diff --git a/sv.c b/sv.c
index 7d7d234..4bbf53a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9483,7 +9483,7 @@ ptr_table_* functions.
 REGEXP *
 Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
 {
-    return CALLREGDUPE(aTHX_ r,param);
+    return CALLREGDUPE(r,param);
 }
 
 /* duplicate a file handle */
@@ -10941,15 +10941,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);       /* even without DEBUGGING. */
 
    
-    /* RE engine - function pointers -- must initilize these before 
-       re_dup() is called. dmq. */
-    PL_regcompp                = proto_perl->Tregcompp;
-    PL_regexecp                = proto_perl->Tregexecp;
-    PL_regint_start    = proto_perl->Tregint_start;
-    PL_regint_string   = proto_perl->Tregint_string;
-    PL_regfree         = proto_perl->Tregfree;
-    PL_regdupe          = proto_perl->Tregdupe;
-    
+    /* RE engine related */
     Zero(&PL_reg_state, 1, struct re_save_state);
     PL_reginterp_cnt   = 0;
     PL_regmatch_slab   = NULL;
index d25db06..e74f67a 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -165,22 +165,6 @@ PERLVARA(Tcolors,6,        char *)         /* from regcomp.c */
 
 PERLVARI(Tpeepp,       peep_t, MEMBER_TO_FPTR(Perl_peep))
                                        /* Pointer to peephole optimizer */
-PERLVARI(Tregcompp,    regcomp_t, MEMBER_TO_FPTR(Perl_pregcomp))
-                                       /* Pointer to REx compiler */
-PERLVARI(Tregexecp,    regexec_t, MEMBER_TO_FPTR(Perl_regexec_flags))
-                                       /* Pointer to REx executer */
-PERLVARI(Tregint_start,        re_intuit_start_t, MEMBER_TO_FPTR(Perl_re_intuit_start))
-                                       /* Pointer to optimized REx executer */
-PERLVARI(Tregint_string,re_intuit_string_t, MEMBER_TO_FPTR(Perl_re_intuit_string))
-                                       /* Pointer to optimized REx string */
-PERLVARI(Tregfree,     regfree_t, MEMBER_TO_FPTR(Perl_pregfree))
-                                       /* Pointer to REx free()er */
-
-#if defined(USE_ITHREADS)
-PERLVARI(Tregdupe,     regdupe_t, MEMBER_TO_FPTR(Perl_regdupe))
-                                       /* Pointer to REx dupe()er */
-#endif
-
 
 PERLVARI(Treginterp_cnt,int,       0)  /* Whether "Regexp" was interpolated. */
 PERLVARI(Twatchaddr,   char **,    0)