This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Reworked Trie Patch
authorYves Orton <demerphq@gmail.com>
Mon, 14 Mar 2005 08:55:39 +0000 (09:55 +0100)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 18 Mar 2005 15:04:39 +0000 (15:04 +0000)
Date: Mon, 14 Mar 2005 08:55:39 +0100
Message-ID: <9b18b31105031323557019ae1@mail.gmail.com>

Subject: Re: Reworked Trie Patch
From: demerphq <demerphq@gmail.com>
Date: Wed, 16 Mar 2005 19:48:18 +0100
Message-ID: <9b18b31105031610481025a080@mail.gmail.com>

Plus minor nits in the documentation of re.pm,
a version bump, and addition of an OPTIMIZE alias

p4raw-id: //depot/perl@24044

17 files changed:
MANIFEST
embed.fnc
embed.h
ext/re/re.pm
pod/perlvar.pod
proto.h
regcomp.c
regcomp.h
regcomp.sym
regexec.c
regnodes.h
sv.c
t/op/pat.t
t/op/re_tests
t/op/readdir.t
t/op/regexp_notrie.t [new file with mode: 0644]
t/op/regexp_trielist.t [new file with mode: 0644]

index f80fd3d..7330ef3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2750,6 +2750,8 @@ t/op/recurse.t                    See if deep recursion works
 t/op/ref.t                     See if refs and objects work
 t/op/regexp_noamp.t            See if regular expressions work with optimizations
 t/op/regexp_qr.t               See if regular expressions work as qr//
+t/op/regexp_trielist.t         See if regular expressions work with trie optimisation
+t/op/regexp_notrie.t           See if regular expressions work without trie optimisation
 t/op/regexp.t                  See if regular expressions work
 t/op/regmesg.t                 See if one can get regular expression errors
 t/op/repeat.t                  See if x operator works
index 282e599..fe77139 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1128,11 +1128,15 @@ Es      |void   |cl_or          |struct RExC_state_t*|struct regnode_charclass_class *cl \
                                |struct regnode_charclass_class *or_with
 Es     |I32    |study_chunk    |struct RExC_state_t*|regnode **scanp|I32 *deltap \
                                |regnode *last|struct scan_data_t *data \
-                               |U32 flags
+                               |U32 flags|U32 depth
 Es     |I32    |add_data       |struct RExC_state_t*|I32 n|char *s
 rs     |void|re_croak2 |const char* pat1|const char* pat2|...
 Es     |I32    |regpposixcc    |struct RExC_state_t*|I32 value
 Es     |void   |checkposixcc   |struct RExC_state_t*
+
+Es     |I32    |make_trie      |struct RExC_state_t*|regnode *startbranch \
+                               |regnode *first|regnode *last|regnode *tail \
+                               |U32 flags
 #endif
 
 #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index c258e8f..1cca988 100644 (file)
--- a/embed.h
+++ b/embed.h
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define checkposixcc           S_checkposixcc
 #endif
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#define make_trie              S_make_trie
+#endif
 #endif
 #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define cl_or(a,b,c)           S_cl_or(aTHX_ a,b,c)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
-#define study_chunk(a,b,c,d,e,f)       S_study_chunk(aTHX_ a,b,c,d,e,f)
+#define study_chunk(a,b,c,d,e,f,g)     S_study_chunk(aTHX_ a,b,c,d,e,f,g)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define add_data(a,b,c)                S_add_data(aTHX_ a,b,c)
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define checkposixcc(a)                S_checkposixcc(aTHX_ a)
 #endif
+#if defined(PERL_CORE) || defined(PERL_EXT)
+#define make_trie(a,b,c,d,e,f) S_make_trie(aTHX_ a,b,c,d,e,f)
+#endif
 #endif
 #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
 #if defined(PERL_CORE) || defined(PERL_EXT)
index bf26fd2..edc6cb8 100644 (file)
@@ -1,6 +1,6 @@
 package re;
 
-our $VERSION = 0.04;
+our $VERSION = 0.05;
 
 =head1 NAME
 
@@ -30,6 +30,10 @@ re - Perl pragma to alter regular expression behaviour
     use re 'debugcolor';          # same as 'debug', but with colored output
     ...
 
+    use re qw(Debug All);          # Finer tuned debugging options.
+    use re qw(Debug More);         # Similarly not lexically scoped.
+    no re qw(Debug ALL);           # Turn of all re dugging and unload the module.
+
 (We use $^X in these examples because it's tainted by default.)
 
 =head1 DESCRIPTION
@@ -67,8 +71,29 @@ comma-separated list of C<termcap> properties to use for highlighting
 strings on/off, pre-point part on/off.
 See L<perldebug/"Debugging regular expressions"> for additional info.
 
-The directive C<use re 'debug'> is I<not lexically scoped>, as the
-other directives are.  It has both compile-time and run-time effects.
+Similarly C<use re 'Debug'> produces debugging output, the difference
+being that it allows the fine tuning of what debugging output will be
+emitted. Following the 'Debug' keyword one of several options may be
+provided: COMPILE, EXECUTE, TRIE_COMPILE, TRIE_EXECUTE, TRIE_MORE,
+OPTIMISE, OFFSETS and ALL. Additionally the special keywords 'All' and
+'More' may be provided. 'All' represents everything but OPTIMISE and
+OFFSETS and TRIE_MORE, and 'More' is similar but include TRIE_MORE.
+Saying C<< no re Debug => 'EXECUTE' >> will disable executing debug
+statements and saying C<< use re Debug => 'EXECUTE' >> will turn it on. Note
+that these flags can be set directly via ${^RE_DEBUG_FLAGS} by using the
+following flag values:
+
+    RE_DEBUG_COMPILE       1
+    RE_DEBUG_EXECUTE       2
+    RE_DEBUG_TRIE_COMPILE  4
+    RE_DEBUG_TRIE_EXECUTE  8
+    RE_DEBUG_TRIE_MORE    16
+    RE_DEBUG_OPTIMISE     32
+    RE_DEBUG_OFFSETS      64
+
+The directive C<use re 'debug'> and its equivalents are I<not> lexically
+scoped, as the other directives are.  They have both compile-time and run-time
+effects.
 
 See L<perlmodlib/Pragmatic Modules>.
 
@@ -95,6 +120,22 @@ sub setcolor {
  };
 }
 
+my %flags = (
+    COMPILE      => 1,
+    EXECUTE      => 2,
+    TRIE_COMPILE => 4,
+    TRIE_EXECUTE => 8,
+    TRIE_MORE    => 16,
+    OPTIMISE     => 32,
+    OPTIMIZE     => 32, # alias
+    OFFSETS      => 64,
+    ALL          => 127,
+    All          => 15,
+    More         => 31,
+);
+
+my $installed = 0;
+
 sub bits {
     my $on = shift;
     my $bits = 0;
@@ -102,21 +143,53 @@ sub bits {
        require Carp;
        Carp::carp("Useless use of \"re\" pragma");
     }
-    foreach my $s (@_){
-      if ($s eq 'debug' or $s eq 'debugcolor') {
-         setcolor() if $s eq 'debugcolor';
-         require XSLoader;
-         XSLoader::load('re');
-         install() if $on;
-         uninstall() unless $on;
-         next;
-      }
-      if (exists $bitmask{$s}) {
-         $bits |= $bitmask{$s};
-      } else {
-         require Carp;
-         Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: @{[join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask)]})");
-      }
+    foreach my $idx (0..$#_){
+        my $s=$_[$idx];
+        if ($s eq 'Debug' or $s eq 'Debugcolor') {
+            setcolor() if $s eq 'Debugcolor';
+            ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
+            require XSLoader;
+            XSLoader::load('re');
+            for my $idx ($idx+1..$#_) {
+                if ($flags{$_[$idx]}) {
+                    if ($on) {
+                        ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
+                    } else {
+                        ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
+                    }
+                } else {
+                    require Carp;
+                    Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
+                               join(", ",sort { $flags{$a} <=> $flags{$b} } keys %flags ) );
+                }
+            }
+            if ($on) {
+                install() unless $installed;
+                $installed = 1;
+            } elsif (!${^RE_DEBUG_FLAGS}) {
+                uninstall() if $installed;
+                $installed = 0;
+            }
+            last;
+        } elsif ($s eq 'debug' or $s eq 'debugcolor') {
+           setcolor() if $s eq 'debugcolor';
+           require XSLoader;
+           XSLoader::load('re');
+           if ($on) {
+               install() unless $installed;
+               $installed=1;
+           } else {
+               uninstall() if $installed;
+               $installed=0;
+           }
+        } elsif (exists $bitmask{$s}) {
+           $bits |= $bitmask{$s};
+       } else {
+           require Carp;
+           Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
+                       join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
+                       ")");
+       }
     }
     $bits;
 }
index 292f444..af13c81 100644 (file)
@@ -929,6 +929,21 @@ The current value of the debugging flags.  (Mnemonic: value of B<-D>
 switch.) May be read or set. Like its command-line equivalent, you can use
 numeric or symbolic values, eg C<$^D = 10> or C<$^D = "st">.
 
+=item ${^RE_DEBUG_FLAGS}
+
+The current value of the regex debugging flags. Set to 0 for no debug output
+even when the re 'debug' module is loaded. See L<re> for details.
+
+=item ${^RE_TRIE_MAXBUFF}
+
+Controls how certain regex optimisations are applied and how much memory they
+utilize. This value by default is 65536 which corresponds to a 512kB temporary
+cache. Set this to a higher value to trade memory for speed when matching
+large alternations. Set it to a lower value if you want the optimisations to
+be as conservative of memory as possible but still occur, and set it to a
+negative value to prevent the optimisation and conserve the most memory.
+Under normal situations this variable should be of no interest to you.
+
 =item $SYSTEM_FD_MAX
 
 =item $^F
diff --git a/proto.h b/proto.h
index bb90daa..21f23a4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1082,11 +1082,13 @@ STATIC void     S_cl_init(pTHX_ struct RExC_state_t*, struct regnode_charclass_class
 STATIC void    S_cl_init_zero(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl);
 STATIC void    S_cl_and(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *and_with);
 STATIC void    S_cl_or(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with);
-STATIC I32     S_study_chunk(pTHX_ struct RExC_state_t*, regnode **scanp, I32 *deltap, regnode *last, struct scan_data_t *data, U32 flags);
+STATIC I32     S_study_chunk(pTHX_ struct RExC_state_t*, regnode **scanp, I32 *deltap, regnode *last, struct scan_data_t *data, U32 flags, U32 depth);
 STATIC I32     S_add_data(pTHX_ struct RExC_state_t*, I32 n, char *s);
 STATIC void    S_re_croak2(pTHX_ const char* pat1, const char* pat2, ...) __attribute__((noreturn));
 STATIC I32     S_regpposixcc(pTHX_ struct RExC_state_t*, I32 value);
 STATIC void    S_checkposixcc(pTHX_ struct RExC_state_t*);
+
+STATIC I32     S_make_trie(pTHX_ struct RExC_state_t*, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags);
 #endif
 
 #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
index e9532bf..12bd96b 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -428,7 +428,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  */
 
 #define MJD_OFFSET_DEBUG(x)
-/* #define MJD_OFFSET_DEBUG(x) Perl_warn_nocontext x */
+/* #define MJD_OFFSET_DEBUG(x) DEBUG_r(Perl_warn_nocontext x) */
 
 
 #define Set_Node_Offset_To_R(node,byte) STMT_START {                   \
@@ -661,6 +661,873 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str
 }
 
 /*
+
+ make_trie(startbranch,first,last,tail,flags)
+  startbranch: the first branch in the whole branch sequence
+  first      : start branch of sequence of branch-exact nodes.
+              May be the same as startbranch
+  last       : Thing following the last branch.
+              May be the same as tail.
+  tail       : item following the branch sequence
+  flags      : currently the OP() type we will be building one of /EXACT(|F|Fl)/
+
+Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
+
+A trie is an N'ary tree where the branches are determined by digital
+decomposition of the key. IE, at the root node you look up the 1st character and
+follow that branch repeat until you find the end of the branches. Nodes can be
+marked as "accepting" meaning they represent a complete word. Eg:
+
+  /he|she|his|hers/
+
+would convert into the following structure. Numbers represent states, letters
+following numbers represent valid transitions on the letter from that state, if
+the number is in square brackets it represents an accepting state, otherwise it
+will be in parenthesis.
+
+      +-h->+-e->[3]-+-r->(8)-+-s->[9]
+      |    |
+      |   (2)
+      |    |
+     (1)   +-i->(6)-+-s->[7]
+      |
+      +-s->(3)-+-h->(4)-+-e->[5]
+
+      Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
+
+This shows that when matching against the string 'hers' we will begin at state 1
+read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
+then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
+is also accepting. Thus we know that we can match both 'he' and 'hers' with a
+single traverse. We store a mapping from accepting to state to which word was
+matched, and then when we have multiple possibilities we try to complete the
+rest of the regex in the order in which they occured in the alternation.
+
+The only prior NFA like behaviour that would be changed by the TRIE support is
+the silent ignoring of duplicate alternations which are of the form:
+
+ / (DUPE|DUPE) X? (?{ ... }) Y /x
+
+Thus EVAL blocks follwing a trie may be called a different number of times with
+and without the optimisation. With the optimisations dupes will be silently
+ignored. This inconsistant behaviour of EVAL type nodes is well established as
+the following demonstrates:
+
+ 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
+
+which prints out 'word' three times, but
+
+ 'words'=~/(word|word|word)(?{ print $1 })S/
+
+which doesnt print it out at all. This is due to other optimisations kicking in.
+
+Example of what happens on a structural level:
+
+The regexp /(ac|ad|ab)+/ will produce the folowing debug output:
+
+   1: CURLYM[1] {1,32767}(18)
+   5:   BRANCH(8)
+   6:     EXACT <ac>(16)
+   8:   BRANCH(11)
+   9:     EXACT <ad>(16)
+  11:   BRANCH(14)
+  12:     EXACT <ab>(16)
+  16:   SUCCEED(0)
+  17:   NOTHING(18)
+  18: END(0)
+
+This would be optimizable with startbranch=5, first=5, last=16, tail=16
+and should turn into:
+
+   1: CURLYM[1] {1,32767}(18)
+   5:   TRIE(16)
+       [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
+         <ac>
+         <ad>
+         <ab>
+  16:   SUCCEED(0)
+  17:   NOTHING(18)
+  18: END(0)
+
+Cases where tail != last would be like /(?foo|bar)baz/:
+
+   1: BRANCH(4)
+   2:   EXACT <foo>(8)
+   4: BRANCH(7)
+   5:   EXACT <bar>(8)
+   7: TAIL(8)
+   8: EXACT <baz>(10)
+  10: END(0)
+
+which would be optimizable with startbranch=1, first=1, last=7, tail=8
+and would end up looking like:
+
+    1: TRIE(8)
+      [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
+       <foo>
+       <bar>
+   7: TAIL(8)
+   8: EXACT <baz>(10)
+  10: END(0)
+
+*/
+
+#define TRIE_DEBUG_CHAR                                                    \
+    DEBUG_TRIE_COMPILE_r({                                                 \
+       SV *tmp;                                                           \
+       if ( UTF ) {                                                       \
+           tmp = newSVpv( "", 0 );                                        \
+           pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX );         \
+       } else {                                                           \
+           tmp = Perl_newSVpvf_nocontext( "%c", uvc );                    \
+       }                                                                  \
+       av_push( trie->revcharmap, tmp );                                  \
+    })
+
+#define TRIE_READ_CHAR STMT_START {                                           \
+    if ( UTF ) {                                                              \
+       if ( folder ) {                                                       \
+           if ( foldlen > 0 ) {                                              \
+              uvc = utf8n_to_uvuni( scan, UTF8_MAXLEN, &len, uniflags );     \
+              foldlen -= len;                                                \
+              scan += len;                                                   \
+              len = 0;                                                       \
+           } else {                                                          \
+               uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags);  \
+               uvc = to_uni_fold( uvc, foldbuf, &foldlen );                  \
+               foldlen -= UNISKIP( uvc );                                    \
+               scan = foldbuf + UNISKIP( uvc );                              \
+           }                                                                 \
+       } else {                                                              \
+           uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags);      \
+       }                                                                     \
+    } else {                                                                  \
+       uvc = (U32)*uc;                                                       \
+       len = 1;                                                              \
+    }                                                                         \
+} STMT_END
+
+
+#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
+#define TRIE_LIST_CUR(state)  ( TRIE_LIST_ITEM( state, 0 ).forid )
+#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
+#define TRIE_LIST_USED(idx)  ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
+
+#define TRIE_LIST_PUSH(state,fid,ns) STMT_START {               \
+    if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) {    \
+       TRIE_LIST_LEN( state ) *= 2;                            \
+       Renew( trie->states[ state ].trans.list,                \
+              TRIE_LIST_LEN( state ), reg_trie_trans_le );     \
+    }                                                           \
+    TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid;     \
+    TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns;   \
+    TRIE_LIST_CUR( state )++;                                   \
+} STMT_END
+
+#define TRIE_LIST_NEW(state) STMT_START {                       \
+    Newz( 1023, trie->states[ state ].trans.list,               \
+       4, reg_trie_trans_le );                                 \
+     TRIE_LIST_CUR( state ) = 1;                                \
+     TRIE_LIST_LEN( state ) = 4;                                \
+} STMT_END
+
+STATIC I32
+S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags)
+{
+    /* first pass, loop through and scan words */
+    reg_trie_data *trie;
+    regnode *cur;
+    U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+    STRLEN len = 0;
+    UV uvc = 0;
+    U16 curword = 0;
+    U32 next_alloc = 0;
+    /* we just use folder as a flag in utf8 */
+    const U8 *folder=( flags == EXACTF
+                       ? PL_fold
+                       : ( flags == EXACTFL
+                           ? PL_fold_locale
+                           : NULL
+                         )
+                     );
+
+    U32 data_slot = add_data( pRExC_state, 1, "t" );
+    SV *re_trie_maxbuff;
+
+    GET_RE_DEBUG_FLAGS_DECL;
+
+    Newz( 848200, trie, 1, reg_trie_data );
+    trie->refcount = 1;
+    RExC_rx->data->data[ data_slot ] = (void*)trie;
+    Newz( 848201, trie->charmap, 256, U16 );
+    DEBUG_r({
+        trie->words = newAV();
+        trie->revcharmap = newAV();
+    });
+
+
+    re_trie_maxbuff=get_sv(RE_TRIE_MAXBUFF, 1);
+    if (!SvIOK(re_trie_maxbuff)) {
+        sv_setiv(re_trie_maxbuff, TRIE_SIMPLE_MAX_BUFF);
+    }
+
+    /*  -- First loop and Setup --
+
+       We first traverse the branches and scan each word to determine if it
+       contains widechars, and how many unique chars there are, this is
+       important as we have to build a table with at least as many columns as we
+       have unique chars.
+
+       We use an array of integers to represent the character codes 0..255
+       (trie->charmap) and we use a an HV* to store unicode characters. We use the
+       native representation of the character value as the key and IV's for the
+       coded index.
+
+       *TODO* If we keep track of how many times each character is used we can
+       remap the columns so that the table compression later on is more
+       efficient in terms of memory by ensuring most common value is in the
+       middle and the least common are on the outside.  IMO this would be better
+       than a most to least common mapping as theres a decent chance the most
+       common letter will share a node with the least common, meaning the node
+       will not be compressable. With a middle is most common approach the worst
+       case is when we have the least common nodes twice.
+
+     */
+
+
+    for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
+        regnode *noper = NEXTOPER( cur );
+        U8 *uc  = (U8*)STRING( noper );
+        U8 *e   = uc + STR_LEN( noper );
+        STRLEN foldlen = 0;
+        U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+        U8 *scan;
+
+        for ( ; uc < e ; uc += len ) {
+            trie->charcount++;
+            TRIE_READ_CHAR;
+            if ( uvc < 256 ) {
+                if ( !trie->charmap[ uvc ] ) {
+                    trie->charmap[ uvc ]=( ++trie->uniquecharcount );
+                    if ( folder )
+                        trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
+                    TRIE_DEBUG_CHAR;
+                }
+            } else {
+                SV** svpp;
+                if ( !trie->widecharmap )
+                    trie->widecharmap = newHV();
+
+                svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
+
+                if ( !svpp )
+                    Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%X", uvc );
+
+                if ( !SvTRUE( *svpp ) ) {
+                    sv_setiv( *svpp, ++trie->uniquecharcount );
+                    TRIE_DEBUG_CHAR;
+                }
+            }
+        }
+        trie->wordcount++;
+    } /* end first pass */
+    DEBUG_TRIE_COMPILE_r(
+        PerlIO_printf( Perl_debug_log, "TRIE(%s): W:%d C:%d Uq:%d \n",
+                ( trie->widecharmap ? "UTF8" : "NATIVE" ), trie->wordcount,
+                trie->charcount, trie->uniquecharcount )
+    );
+
+
+    /*
+        We now know what we are dealing with in terms of unique chars and
+        string sizes so we can calculate how much memory a naive
+        representation using a flat table  will take. If its over a reasonable
+        limit (as specified by $^RE_TRIE_MAXBUFF) we use a more memory
+        conservative but potentially much slower representation using an array
+        of lists.
+
+        At the end we convert both representations into the same compressed
+        form that will be used in regexec.c for matching with. The latter
+        is a form that cannot be used to construct with but has memory
+        properties similar to the list form and access properties similar
+        to the table form making it both suitable for fast searches and
+        small enough that its feasable to store for the duration of a program.
+
+        See the comment in the code where the compressed table is produced
+        inplace from the flat tabe representation for an explanation of how
+        the compression works.
+
+    */
+
+
+    if ( (IV)( ( trie->charcount + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
+        /*
+            Second Pass -- Array Of Lists Representation
+
+            Each state will be represented by a list of charid:state records
+            (reg_trie_trans_le) the first such element holds the CUR and LEN
+            points of the allocated array. (See defines above).
+
+            We build the initial structure using the lists, and then convert
+            it into the compressed table form which allows faster lookups
+            (but cant be modified once converted).
+
+
+        */
+
+
+        STRLEN transcount = 1;
+
+        Newz( 848204, trie->states, trie->charcount + 2, reg_trie_state );
+        TRIE_LIST_NEW(1);
+        next_alloc = 2;
+
+        for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
+
+        regnode *noper   = NEXTOPER( cur );
+        U8 *uc           = (U8*)STRING( noper );
+        U8 *e            = uc + STR_LEN( noper );
+        U32 state        = 1;         /* required init */
+        U16 charid       = 0;         /* sanity init */
+        U8 *scan         = (U8*)NULL; /* sanity init */
+        STRLEN foldlen   = 0;         /* required init */
+        U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+
+
+        for ( ; uc < e ; uc += len ) {
+
+            TRIE_READ_CHAR;
+
+            if ( uvc < 256 ) {
+                charid = trie->charmap[ uvc ];
+            } else {
+                SV** svpp=(SV**)NULL;
+                svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
+                if ( !svpp ) {
+                    charid = 0;
+                } else {
+                    charid=(U16)SvIV( *svpp );
+                }
+            }
+            if ( charid ) {
+
+                U16 check;
+                U32 newstate = 0;
+
+                charid--;
+                if ( !trie->states[ state ].trans.list ) {
+                    TRIE_LIST_NEW( state );
+                }
+                for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
+                    if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
+                        newstate = TRIE_LIST_ITEM( state, check ).newstate;
+                        break;
+                    }
+                    }
+                    if ( ! newstate ) {
+                        newstate = next_alloc++;
+                        TRIE_LIST_PUSH( state, charid, newstate );
+                        transcount++;
+                    }
+                    state = newstate;
+
+            } else {
+                Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %d", uvc );
+            }
+            /* charid is now 0 if we dont know the char read, or nonzero if we do */
+        }
+
+        if ( !trie->states[ state ].wordnum ) {
+            /* we havent inserted this word into the structure yet. */
+            trie->states[ state ].wordnum = ++curword;
+
+            DEBUG_r({
+                /* store the word for dumping */
+                SV* tmp = newSVpvn( STRING( noper ), STR_LEN( noper ) );
+                if ( UTF ) SvUTF8_on( tmp );
+                av_push( trie->words, tmp );
+            });
+
+        } else {
+            /* Its a dupe. So ignore it. */
+        }
+
+        } /* end second pass */
+
+        trie->laststate = next_alloc;
+        Renew( trie->states, next_alloc, reg_trie_state );
+
+        DEBUG_TRIE_COMPILE_MORE_r({
+            U32 state;
+            U16 charid;
+
+            /*
+               print out the table precompression.
+             */
+
+            PerlIO_printf( Perl_debug_log, "\nState :Word | Transition Data\n" );
+            PerlIO_printf( Perl_debug_log,   "------:-----+-----------------" );
+
+            for( state=1 ; state < next_alloc ; state ++ ) {
+
+                PerlIO_printf( Perl_debug_log, "\n %04X :", state  );
+                if ( ! trie->states[ state ].wordnum ) {
+                    PerlIO_printf( Perl_debug_log, "%5s| ","");
+                } else {
+                    PerlIO_printf( Perl_debug_log, "W%04X| ",
+                        trie->states[ state ].wordnum
+                    );
+                }
+                for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
+                    SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
+                    PerlIO_printf( Perl_debug_log, "%s:%3X=%04X | ",
+                        SvPV_nolen( *tmp ),
+                        TRIE_LIST_ITEM(state,charid).forid,
+                        TRIE_LIST_ITEM(state,charid).newstate
+                    );
+                }
+
+            }
+            PerlIO_printf( Perl_debug_log, "\n\n" );
+        });
+
+        Newz( 848203, trie->trans, transcount ,reg_trie_trans );
+        {
+            U32 state;
+            U16 idx;
+            U32 tp = 0;
+            U32 zp = 0;
+
+
+            for( state=1 ; state < next_alloc ; state ++ ) {
+                U32 base=0;
+
+                /*
+                DEBUG_TRIE_COMPILE_MORE_r(
+                    PerlIO_printf( Perl_debug_log, "tp: %d zp: %d ",tp,zp)
+                );
+                */
+
+                if (trie->states[state].trans.list) {
+                    U16 minid=TRIE_LIST_ITEM( state, 1).forid;
+                    U16 maxid=minid;
+
+
+                    for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
+                        if ( TRIE_LIST_ITEM( state, idx).forid < minid ) {
+                            minid=TRIE_LIST_ITEM( state, idx).forid;
+                        } else if ( TRIE_LIST_ITEM( state, idx).forid > maxid ) {
+                            maxid=TRIE_LIST_ITEM( state, idx).forid;
+                        }
+                    }
+                    if ( transcount < tp + maxid - minid + 1) {
+                        transcount *= 2;
+                        Renew( trie->trans, transcount, reg_trie_trans );
+                        Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
+                    }
+                    base = trie->uniquecharcount + tp - minid;
+                    if ( maxid == minid ) {
+                        U32 set = 0;
+                        for ( ; zp < tp ; zp++ ) {
+                            if ( ! trie->trans[ zp ].next ) {
+                                base = trie->uniquecharcount + zp - minid;
+                                trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
+                                trie->trans[ zp ].check = state;
+                                set = 1;
+                                break;
+                            }
+                        }
+                        if ( !set ) {
+                            trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
+                            trie->trans[ tp ].check = state;
+                            tp++;
+                            zp = tp;
+                        }
+                    } else {
+                        for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
+                            U32 tid = base -  trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
+                            trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
+                            trie->trans[ tid ].check = state;
+                        }
+                        tp += ( maxid - minid + 1 );
+                    }
+                    Safefree(trie->states[ state ].trans.list);
+                }
+                /*
+                DEBUG_TRIE_COMPILE_MORE_r(
+                    PerlIO_printf( Perl_debug_log, " base: %d\n",base);
+                );
+                */
+                trie->states[ state ].trans.base=base;
+            }
+            Renew( trie->trans, tp + 1, reg_trie_trans );
+
+        }
+    } else {
+        /*
+           Second Pass -- Flat Table Representation.
+
+           we dont use the 0 slot of either trans[] or states[] so we add 1 to each.
+           We know that we will need Charcount+1 trans at most to store the data
+           (one row per char at worst case) So we preallocate both structures
+           assuming worst case.
+
+           We then construct the trie using only the .next slots of the entry
+           structs.
+
+           We use the .check field of the first entry of the node  temporarily to
+           make compression both faster and easier by keeping track of how many non
+           zero fields are in the node.
+
+           Since trans are numbered from 1 any 0 pointer in the table is a FAIL
+           transition.
+
+           There are two terms at use here: state as a TRIE_NODEIDX() which is a
+           number representing the first entry of the node, and state as a
+           TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1) and
+           TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3) if there
+           are 2 entrys per node. eg:
+
+             A B       A B
+          1. 2 4    1. 3 7
+          2. 0 3    3. 0 5
+          3. 0 0    5. 0 0
+          4. 0 0    7. 0 0
+
+           The table is internally in the right hand, idx form. However as we also
+           have to deal with the states array which is indexed by nodenum we have to
+           use TRIE_NODENUM() to convert.
+
+        */
+
+        Newz( 848203, trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1,
+              reg_trie_trans );
+        Newz( 848204, trie->states, trie->charcount + 2, reg_trie_state );
+        next_alloc = trie->uniquecharcount + 1;
+
+        for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
+
+            regnode *noper   = NEXTOPER( cur );
+            U8 *uc           = (U8*)STRING( noper );
+            U8 *e            = uc + STR_LEN( noper );
+
+            U32 state        = 1;         /* required init */
+
+            U16 charid       = 0;         /* sanity init */
+            U32 accept_state = 0;         /* sanity init */
+            U8 *scan         = (U8*)NULL; /* sanity init */
+
+            STRLEN foldlen   = 0;         /* required init */
+            U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+
+
+            for ( ; uc < e ; uc += len ) {
+
+                TRIE_READ_CHAR;
+
+                if ( uvc < 256 ) {
+                    charid = trie->charmap[ uvc ];
+                } else {
+                    SV** svpp=(SV**)NULL;
+                    svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0);
+                    if ( !svpp ) {
+                        charid = 0;
+                    } else {
+                        charid=(U16)SvIV( *svpp );
+                    }
+                }
+                if ( charid ) {
+                    charid--;
+                    if ( !trie->trans[ state + charid ].next ) {
+                        trie->trans[ state + charid ].next = next_alloc;
+                        trie->trans[ state ].check++;
+                        next_alloc += trie->uniquecharcount;
+                    }
+                    state = trie->trans[ state + charid ].next;
+                } else {
+                    Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %d", uvc );
+                }
+                /* charid is now 0 if we dont know the char read, or nonzero if we do */
+            }
+
+            accept_state = TRIE_NODENUM( state );
+            if ( !trie->states[ accept_state ].wordnum ) {
+                /* we havent inserted this word into the structure yet. */
+                trie->states[ accept_state ].wordnum = ++curword;
+
+                DEBUG_r({
+                    /* store the word for dumping */
+                    SV* tmp = newSVpvn( STRING( noper ), STR_LEN( noper ) );
+                    if ( UTF ) SvUTF8_on( tmp );
+                    av_push( trie->words, tmp );
+                });
+
+            } else {
+                /* Its a dupe. So ignore it. */
+            }
+
+        } /* end second pass */
+
+        DEBUG_TRIE_COMPILE_MORE_r({
+            /*
+               print out the table precompression so that we can do a visual check
+               that they are identical.
+             */
+            U32 state;
+            U16 charid;
+            PerlIO_printf( Perl_debug_log, "\nChar : " );
+
+            for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
+                SV **tmp = av_fetch( trie->revcharmap, charid, 0);
+                if ( tmp ) {
+                  PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) );
+                }
+            }
+
+            PerlIO_printf( Perl_debug_log, "\nState+-" );
+
+            for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
+                PerlIO_printf( Perl_debug_log, "%4s-", "----" );
+            }
+
+            PerlIO_printf( Perl_debug_log, "\n" );
+
+            for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
+
+                PerlIO_printf( Perl_debug_log, "%04X : ", TRIE_NODENUM( state ) );
+
+                for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
+                    PerlIO_printf( Perl_debug_log, "%04X ",
+                        SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
+                }
+                if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
+                    PerlIO_printf( Perl_debug_log, " (%04X)\n", trie->trans[ state ].check );
+                } else {
+                    PerlIO_printf( Perl_debug_log, " (%04X) W%04X\n", trie->trans[ state ].check,
+                    trie->states[ TRIE_NODENUM( state ) ].wordnum );
+                }
+            }
+            PerlIO_printf( Perl_debug_log, "\n\n" );
+        });
+        {
+        /*
+           * Inplace compress the table.*
+
+           For sparse data sets the table constructed by the trie algorithm will
+           be mostly 0/FAIL transitions or to put it another way mostly empty.
+           (Note that leaf nodes will not contain any transitions.)
+
+           This algorithm compresses the tables by eliminating most such
+           transitions, at the cost of a modest bit of extra work during lookup:
+
+           - Each states[] entry contains a .base field which indicates the
+           index in the state[] array wheres its transition data is stored.
+
+           - If .base is 0 there are no  valid transitions from that node.
+
+           - If .base is nonzero then charid is added to it to find an entry in
+           the trans array.
+
+           -If trans[states[state].base+charid].check!=state then the
+           transition is taken to be a 0/Fail transition. Thus if there are fail
+           transitions at the front of the node then the .base offset will point
+           somewhere inside the previous nodes data (or maybe even into a node
+           even earlier), but the .check field determines if the transition is
+           valid.
+
+           The following process inplace converts the table to the compressed
+           table: We first do not compress the root node 1,and mark its all its
+           .check pointers as 1 and set its .base pointer as 1 as well. This
+           allows to do a DFA construction from the compressed table later, and
+           ensures that any .base pointers we calculate later are greater than
+           0.
+
+           - We set 'pos' to indicate the first entry of the second node.
+
+           - We then iterate over the columns of the node, finding the first and
+           last used entry at l and m. We then copy l..m into pos..(pos+m-l),
+           and set the .check pointers accordingly, and advance pos
+           appropriately and repreat for the next node. Note that when we copy
+           the next pointers we have to convert them from the original
+           NODEIDX form to NODENUM form as the former is not valid post
+           compression.
+
+           - If a node has no transitions used we mark its base as 0 and do not
+           advance the pos pointer.
+
+           - If a node only has one transition we use a second pointer into the
+           structure to fill in allocated fail transitions from other states.
+           This pointer is independent of the main pointer and scans forward
+           looking for null transitions that are allocated to a state. When it
+           finds one it writes the single transition into the "hole".  If the
+           pointer doesnt find one the single transition is appeneded as normal.
+
+           - Once compressed we can Renew/realloc the structures to release the
+           excess space.
+
+           See "Table-Compression Methods" in sec 3.9 of the Red Dragon,
+           specifically Fig 3.47 and the associated pseudocode.
+
+           demq
+        */
+        U32 laststate = TRIE_NODENUM( next_alloc );
+        U32 used , state, charid;
+        U32 pos = 0, zp=0;
+        trie->laststate = laststate;
+
+        for ( state = 1 ; state < laststate ; state++ ) {
+            U8 flag = 0;
+            U32 stateidx = TRIE_NODEIDX( state );
+            U32 o_used=trie->trans[ stateidx ].check;
+            used = trie->trans[ stateidx ].check;
+            trie->trans[ stateidx ].check = 0;
+
+            for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
+                if ( flag || trie->trans[ stateidx + charid ].next ) {
+                    if ( trie->trans[ stateidx + charid ].next ) {
+                        if (o_used == 1) {
+                            for ( ; zp < pos ; zp++ ) {
+                                if ( ! trie->trans[ zp ].next ) {
+                                    break;
+                                }
+                            }
+                            trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
+                            trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
+                            trie->trans[ zp ].check = state;
+                            if ( ++zp > pos ) pos = zp;
+                            break;
+                        }
+                        used--;
+                    }
+                    if ( !flag ) {
+                        flag = 1;
+                        trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
+                    }
+                    trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
+                    trie->trans[ pos ].check = state;
+                    pos++;
+                }
+            }
+        }
+        Renew( trie->trans, pos + 1, reg_trie_trans);
+        Renew( trie->states, laststate + 1, reg_trie_state);
+        DEBUG_TRIE_COMPILE_MORE_r(
+                PerlIO_printf( Perl_debug_log, " Alloc: %d Orig: %d elements, Final:%d. Savings of %%%5.2f\n",
+                    ( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ), next_alloc, pos,
+                    ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
+            );
+
+        } /* end table compress */
+    }
+
+    DEBUG_TRIE_COMPILE_r({
+        U32 state;
+        /*
+           Now we print it out again, in a slightly different form as there is additional
+           info we want to be able to see when its compressed. They are close enough for
+           visual comparison though.
+         */
+        PerlIO_printf( Perl_debug_log, "\nChar : %-6s%-6s%-4s ","Match","Base","Ofs" );
+
+        for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
+            SV **tmp = av_fetch( trie->revcharmap, state, 0);
+            if ( tmp ) {
+              PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) );
+            }
+        }
+        PerlIO_printf( Perl_debug_log, "\n-----:-----------------------");
+        for( state = 0 ; state < trie->uniquecharcount ; state++ )
+            PerlIO_printf( Perl_debug_log, "-----");
+        PerlIO_printf( Perl_debug_log, "\n");
+        for( state = 1 ; state < trie->laststate ; state++ ) {
+            U32 base = trie->states[ state ].trans.base;
+
+            PerlIO_printf( Perl_debug_log, "#%04X ", state);
+
+            if ( trie->states[ state ].wordnum ) {
+                PerlIO_printf( Perl_debug_log, " W%04X", trie->states[ state ].wordnum );
+            } else {
+                PerlIO_printf( Perl_debug_log, "%6s", "" );
+            }
+
+            PerlIO_printf( Perl_debug_log, " @%04X ", base );
+
+            if ( base ) {
+                U32 ofs = 0;
+
+                while( ( base + ofs - trie->uniquecharcount ) >=0 &&
+                      trie->trans[ base + ofs - trie->uniquecharcount ].check != state )
+                        ofs++;
+
+                PerlIO_printf( Perl_debug_log, "+%02X[ ", ofs);
+
+                for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
+                    if ( ( base + ofs - trie->uniquecharcount>=0) &&
+                         trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
+                    {
+                       PerlIO_printf( Perl_debug_log, "%04X ",
+                        trie->trans[ base + ofs - trie->uniquecharcount ].next );
+                    } else {
+                        PerlIO_printf( Perl_debug_log, "%4s ","   0" );
+                    }
+                }
+
+                PerlIO_printf( Perl_debug_log, "]", ofs);
+
+            }
+            PerlIO_printf( Perl_debug_log, "\n" );
+        }
+    });
+
+    {
+        /* now finally we "stitch in" the new TRIE node
+           This means we convert either the first branch or the first Exact,
+           depending on whether the thing following (in 'last') is a branch
+           or not and whther first is the startbranch (ie is it a sub part of
+           the alternation or is it the whole thing.)
+           Assuming its a sub part we conver the EXACT otherwise we convert
+           the whole branch sequence, including the first.
+        */
+        regnode *convert;
+
+
+
+
+        if ( first == startbranch && OP( last ) != BRANCH ) {
+            convert = first;
+        } else {
+            convert = NEXTOPER( first );
+            NEXT_OFF( first ) = (U16)(last - first);
+        }
+
+        OP( convert ) = TRIE + (U8)( flags - EXACT );
+        NEXT_OFF( convert ) = (U16)(tail - convert);
+        ARG_SET( convert, data_slot );
+
+        /* tells us if we need to handle accept buffers specially */
+        convert->flags = ( RExC_seen_evals ? 1 : 0 );
+
+
+        /* needed for dumping*/
+        DEBUG_r({
+            regnode *optimize = convert + NODE_STEP_REGNODE + regarglen[ TRIE ];
+            /* We now need to mark all of the space originally used by the
+               branches as optimized away. This keeps the dumpuntil from
+               throwing a wobbly as it doesnt use regnext() to traverse the
+               opcodes.
+             */
+            while( optimize < last ) {
+                OP( optimize ) = OPTIMIZED;
+                optimize++;
+            }
+        });
+    } /* end node insert */
+    return 1;
+}
+
+
+
+/*
  * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
  * These need to be revisited when a newer toolchain becomes available.
  */
@@ -677,8 +1544,9 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str
 /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set
    to the position after last scanned or to NULL. */
 
+
 STATIC I32
-S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags)
+S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, regnode *last, scan_data_t *data, U32 flags, U32 depth)
                        /* scanp: Start here (read-write). */
                        /* deltap: Write maxlen-minlen here. */
                        /* last: Stop before this one. */
@@ -691,9 +1559,17 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
     I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
     scan_data_t data_fake;
     struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */
+    SV *re_trie_maxbuff = NULL;
+
+    GET_RE_DEBUG_FLAGS_DECL;
 
     while (scan && OP(scan) != END && scan < last) {
        /* Peephole optimizer: */
+       DEBUG_OPTIMISE_r({
+         SV *mysv=sv_newmortal();
+         regprop( mysv, scan);
+         PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08X)\n",depth*2,"",SvPV_nolen(mysv),scan);
+       });
 
        if (PL_regkind[(U8)OP(scan)] == EXACT) {
            /* Merge several consecutive EXACTish nodes into one. */
@@ -739,7 +1615,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                }
            }
 
-           if (UTF && OP(scan) == EXACTF && STR_LEN(scan) >= 6) {
+           if (UTF && ( OP(scan) == EXACTF ) && ( STR_LEN(scan) >= 6 ) ) {
 /*
   Two problematic code points in Unicode casefolding of EXACT nodes:
 
@@ -794,6 +1670,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
            }
 #endif
        }
+
+
+
        /* Follow the next-chain of the current node and optimize
           away all the NOTHINGs from it.  */
        if (OP(scan) != CURLYX) {
@@ -816,21 +1695,25 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
            else
                NEXT_OFF(scan) = off;
        }
+
        /* The principal pseudo-switch.  Cannot be a switch, since we
           look into several different things.  */
        if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
                   || OP(scan) == IFTHEN || OP(scan) == SUSPEND) {
            next = regnext(scan);
            code = OP(scan);
+           /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
        
            if (OP(next) == code || code == IFTHEN || code == SUSPEND) {
                I32 max1 = 0, min1 = I32_MAX, num = 0;
                struct regnode_charclass_class accum;
+               regnode *startbranch=scan;
                
                if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */
                    scan_commit(pRExC_state, data); /* Cannot merge strings after this. */
                if (flags & SCF_DO_STCLASS)
                    cl_init_zero(pRExC_state, &accum);
+
                while (OP(scan) == code) {
                    I32 deltanext, minnext, f = 0, fake;
                    struct regnode_charclass_class this_class;
@@ -854,9 +1737,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                    }           
                    if (flags & SCF_WHILEM_VISITED_POS)
                        f |= SCF_WHILEM_VISITED_POS;
+
                    /* we suppose the run is continuous, last=next...*/
                    minnext = study_chunk(pRExC_state, &scan, &deltanext,
-                                         next, &data_fake, f);
+                                         next, &data_fake, f,depth+1);
                    if (min1 > minnext)
                        min1 = minnext;
                    if (max1 < minnext + deltanext)
@@ -909,10 +1793,199 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                        data->start_class->flags |= ANYOF_EOS;
                    }
                }
+
+               /* demq.
+
+                  Assuming this was/is a branch we are dealing with: 'scan' now
+                  points at the item that follows the branch sequence, whatever
+                  it is. We now start at the beginning of the sequence and look
+                  for subsequences of
+
+                  BRANCH->EXACT=>X
+                  BRANCH->EXACT=>X
+
+                  which would be constructed from a pattern like /A|LIST|OF|WORDS/
+
+                  If we can find such a subseqence we need to turn the first
+                  element into a trie and then add the subsequent branch exact
+                  strings to the trie.
+
+                  We have two cases
+
+                    1. patterns where the whole set of branch can be converted to a trie,
+
+                    2. patterns where only a subset of the alternations can be
+                    converted to a trie.
+
+                  In case 1 we can replace the whole set with a single regop
+                  for the trie. In case 2 we need to keep the start and end
+                  branchs so
+
+                    'BRANCH EXACT; BRANCH EXACT; BRANCH X'
+                    becomes BRANCH TRIE; BRANCH X;
+
+                  Hypthetically when we know the regex isnt anchored we can
+                  turn a case 1 into a DFA and let it rip... Every time it finds a match
+                  it would just call its tail, no WHILEM/CURLY needed.
+
+               */
+                if (DO_TRIE) {
+                    if (!re_trie_maxbuff) {
+                        re_trie_maxbuff=get_sv(RE_TRIE_MAXBUFF, 1);
+                        if (!SvIOK(re_trie_maxbuff))
+                            sv_setiv(re_trie_maxbuff, TRIE_SIMPLE_MAX_BUFF);
+
+           }
+                    if ( SvIV(re_trie_maxbuff)>=0 && OP( startbranch )==BRANCH ) {
+                        regnode *cur;
+                        regnode *first = (regnode *)NULL;
+                        regnode *last = (regnode *)NULL;
+                        regnode *tail = scan;
+                        U8 optype = 0;
+                        U32 count=0;
+
+#ifdef DEBUGGING
+                        SV *mysv = sv_newmortal();       /* for dumping */
+#endif
+                        /* var tail is used because there may be a TAIL
+                           regop in the way. Ie, the exacts will point to the
+                           thing following the TAIL, but the last branch will
+                           point at the TAIL. So we advance tail. If we
+                           have nested (?:) we may have to move through several
+                           tails.
+                         */
+
+                        while ( OP( tail ) == TAIL ) {
+                            /* this is the TAIL generated by (?:) */
+                            tail = regnext( tail );
+                        }
+
+                        DEBUG_OPTIMISE_r({
+                            regprop( mysv, tail );
+                            PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
+                                depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ),
+                                (RExC_seen_evals) ? "[EVAL]" : ""
+                            );
+                        });
+                        /*
+
+                           step through the branches, cur represents each
+                           branch, noper is the first thing to be matched
+                           as part of that branch and noper_next is the
+                           regnext() of that node. if noper is an EXACT
+                           and noper_next is the same as scan (our current
+                           position in the regex) then the EXACT branch is
+                           a possible optimization target. Once we have
+                           two or more consequetive such branches we can
+                           create a trie of the EXACT's contents and stich
+                           it in place. If the sequence represents all of
+                           the branches we eliminate the whole thing and
+                           replace it with a single TRIE. If it is a
+                           subsequence then we need to stitch it in. This
+                           means the first branch has to remain, and needs
+                           to be repointed at the item on the branch chain
+                           following the last branch optimized. This could
+                           be either a BRANCH, in which case the
+                           subsequence is internal, or it could be the
+                           item following the branch sequence in which
+                           case the subsequence is at the end.
+
+                        */
+
+                        /* dont use tail as the end marker for this traverse */
+                        for ( cur = startbranch ; cur != scan ; cur = regnext( cur ) ) {
+                            regnode *noper = NEXTOPER( cur );
+                            regnode *noper_next = regnext( noper );
+
+
+                            DEBUG_OPTIMISE_r({
+                                regprop( mysv, cur);
+                                PerlIO_printf( Perl_debug_log, "%*s%s",
+                                   depth * 2 + 2,"  ", SvPV_nolen( mysv ) );
+
+                                regprop( mysv, noper);
+                                PerlIO_printf( Perl_debug_log, " -> %s",
+                                    SvPV_nolen(mysv));
+
+                                if ( noper_next ) {
+                                  regprop( mysv, noper_next );
+                                  PerlIO_printf( Perl_debug_log,"\t=> %s\t",
+                                    SvPV_nolen(mysv));
+                                }
+                                PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n",
+                                   first, last, cur );
+                            });
+                            if ( ( first ? OP( noper ) == optype
+                                         : PL_regkind[ (U8)OP( noper ) ] == EXACT )
+                                  && noper_next == tail && count<U16_MAX)
+                            {
+                                count++;
+                                if ( !first ) {
+                                    first = cur;
+                                    optype = OP( noper );
+                                } else {
+                                    DEBUG_OPTIMISE_r(
+                                        if (!last ) {
+                                            regprop( mysv, first);
+                                            PerlIO_printf( Perl_debug_log, "%*s%s",
+                                              depth * 2 + 2, "F:", SvPV_nolen( mysv ) );
+                                            regprop( mysv, NEXTOPER(first) );
+                                            PerlIO_printf( Perl_debug_log, " -> %s\n",
+                                              SvPV_nolen( mysv ) );
+                                        }
+                                    );
+                                    last = cur;
+                                    DEBUG_OPTIMISE_r({
+                                        regprop( mysv, cur);
+                                        PerlIO_printf( Perl_debug_log, "%*s%s",
+                                          depth * 2 + 2, "N:", SvPV_nolen( mysv ) );
+                                        regprop( mysv, noper );
+                                        PerlIO_printf( Perl_debug_log, " -> %s\n",
+                                          SvPV_nolen( mysv ) );
+                                    });
+                                }
+                            } else {
+                                if ( last ) {
+                                    DEBUG_OPTIMISE_r(
+                                        PerlIO_printf( Perl_debug_log, "%*s%s\n",
+                                            depth * 2 + 2, "E:", "**END**" );
+                                    );
+                                    make_trie( pRExC_state, startbranch, first, cur, tail, optype );
+                                }
+                                if ( PL_regkind[ (U8)OP( noper ) ] == EXACT
+                                     && noper_next == tail )
+                                {
+                                    count = 1;
+                                    first = cur;
+                                    optype = OP( noper );
+                                } else {
+                                    count = 0;
+                                    first = NULL;
+                                    optype = 0;
+                                }
+                                last = NULL;
+                            }
+                        }
+                        DEBUG_OPTIMISE_r({
+                            regprop( mysv, cur);
+                            PerlIO_printf( Perl_debug_log,
+                              "%*s%s\t(0x%p,0x%p,0x%p)\n", depth * 2 + 2,
+                              "  ", SvPV_nolen( mysv ), first, last, cur);
+
+                        });
+                        if ( last ) {
+                            DEBUG_OPTIMISE_r(
+                                PerlIO_printf( Perl_debug_log, "%*s%s\n",
+                                    depth * 2 + 2, "E:", "==END==" );
+                            );
+                            make_trie( pRExC_state, startbranch, first, scan, tail, optype );
+                        }
+                    }
+                }
            }
-           else if (code == BRANCHJ)   /* single branch is optimized. */
+           else if ( code == BRANCHJ ) {  /* single branch is optimized. */
                scan = NEXTOPER(NEXTOPER(scan));
-           else                        /* single branch is optimized. */
+           } else                      /* single branch is optimized. */
                scan = NEXTOPER(scan);
            continue;
        }
@@ -1072,8 +2145,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                next = regnext(scan);
                if (OP(scan) == CURLYX) {
                    I32 lp = (data ? *(data->last_closep) : 0);
-
-                   scan->flags = ((lp <= U8_MAX) ? lp : U8_MAX);
+                   scan->flags = ((lp <= U8_MAX) ? (U8)lp : U8_MAX);
                }
                scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
                next_is_eval = (OP(scan) == EVAL);
@@ -1106,8 +2178,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
 
                /* This will finish on WHILEM, setting scan, or on NULL: */
                minnext = study_chunk(pRExC_state, &scan, &deltanext, last, data,
-                                     mincount == 0
-                                       ? (f & ~SCF_DO_SUBSTR) : f);
+                                     (mincount == 0
+                                       ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
 
                if (flags & SCF_DO_STCLASS)
                    data->start_class = oclass;
@@ -1244,7 +2316,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
 #endif
                        /* Optimize again: */
                        study_chunk(pRExC_state, &nxt1, &deltanext, nxt,
-                                   NULL, 0);
+                                   NULL, 0,depth+1);
                    }
                    else
                        oscan->flags = 0;
@@ -1606,7 +2678,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                f |= SCF_WHILEM_VISITED_POS;
            next = regnext(scan);
            nscan = NEXTOPER(NEXTOPER(scan));
-           minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f);
+           minnext = study_chunk(pRExC_state, &nscan, &deltanext, last, &data_fake, f,depth+1);
            if (scan->flags) {
                if (deltanext) {
                    vFAIL("Variable length lookbehind not implemented");
@@ -1755,15 +2827,17 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     RExC_state_t RExC_state;
     RExC_state_t *pRExC_state = &RExC_state;
 
+    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();
-        PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
+    DEBUG_r(if (!PL_colorset) reginitcolors());
+    DEBUG_COMPILE_r({
+        PerlIO_printf(Perl_debug_log, "%sCompiling REx%s \"%s%*s%s\"\n",
                       PL_colors[4],PL_colors[5],PL_colors[0],
                       (int)(xend - exp), RExC_precomp, PL_colors[1]);
     });
@@ -1792,7 +2866,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        RExC_precomp = Nullch;
        return(NULL);
     }
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
+    DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
 
     /* Small enough for pointer-storage convention?
        If extralen==0, this means that we will not need long jumps. */
@@ -1831,7 +2905,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     if (r->offsets) {
       r->offsets[0] = RExC_size; 
     }
-    DEBUG_r(PerlIO_printf(Perl_debug_log, 
+    DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
                           "%s %"UVuf" bytes for offset annotations.\n", 
                           r->offsets ? "Got" : "Couldn't get", 
                           (UV)((2*RExC_size+1) * sizeof(U32))));
@@ -1853,6 +2927,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     if (reg(pRExC_state, 0, &flags) == NULL)
        return(NULL);
 
+
     /* Dig out information for optimizations. */
     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
     pm->op_pmflags = RExC_flags;
@@ -1941,7 +3016,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->reganch |= ROPT_SKIP;
 
        /* Scan is after the zeroth branch, first is atomic matcher. */
-       DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
+       DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
                              (IV)(first - scan + 1)));
        /*
        * If there's something expensive in the r.e., find the
@@ -1970,7 +3045,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        data.last_closep = &last_close;
 
        minlen = study_chunk(pRExC_state, &first, &fake, scan + RExC_size, /* Up to end */
-                            &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag);
+                            &data, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0);
        if ( RExC_npar == 1 && data.longest == &(data.longest_fixed)
             && data.last_start_min == 0 && data.last_end > 0
             && !RExC_seen_zerolen
@@ -2055,7 +3130,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->regstclass = (regnode*)RExC_rx->data->data[n];
            r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
            PL_regdata = r->data; /* for regprop() */
-           DEBUG_r({ SV *sv = sv_newmortal();
+           DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
                      regprop(sv, (regnode*)data.start_class);
                      PerlIO_printf(Perl_debug_log,
                                    "synthetic stclass `%s'.\n",
@@ -2090,12 +3165,12 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        struct regnode_charclass_class ch_class;
        I32 last_close = 0;
        
-       DEBUG_r(PerlIO_printf(Perl_debug_log, "\n"));
+       DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "\n"));
        scan = r->program + 1;
        cl_init(pRExC_state, &ch_class);
        data.start_class = &ch_class;
        data.last_closep = &last_close;
-       minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS);
+       minlen = study_chunk(pRExC_state, &scan, &fake, scan + RExC_size, &data, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS,0);
        r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
                = r->float_substr = r->float_utf8 = Nullsv;
        if (!(data.start_class->flags & ANYOF_EOS)
@@ -2110,7 +3185,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
                       struct regnode_charclass_class);
            r->regstclass = (regnode*)RExC_rx->data->data[n];
            r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
-           DEBUG_r({ SV* sv = sv_newmortal();
+           DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
                      regprop(sv, (regnode*)data.start_class);
                      PerlIO_printf(Perl_debug_log,
                                    "synthetic stclass `%s'.\n",
@@ -2130,7 +3205,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     Newz(1002, r->startp, RExC_npar, I32);
     Newz(1002, r->endp, RExC_npar, I32);
     PL_regdata = r->data; /* for regprop() */
-    DEBUG_r(regdump(r));
+    DEBUG_COMPILE_r(regdump(r));
     return(r);
 }
 
@@ -3345,7 +4420,8 @@ tryagain:
            if (SvUTF8(sv))
                RExC_utf8 = 1;
            if (!SIZE_ONLY) {
-               DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
+               GET_RE_DEBUG_FLAGS_DECL;
+               DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
                                      (int)oldlen, STRING(ret),
                                      (int)newlen, s));
                Copy(s, STRING(ret), newlen, char);
@@ -4630,6 +5706,43 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
        else if (PL_regkind[(U8)op] == BRANCH) {
            node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
        }
+       else if ( PL_regkind[(U8)op]  == TRIE ) {
+           I32 n = ARG(node);
+           reg_trie_data *trie=(reg_trie_data*)PL_regdata->data[n];
+           I32 word_idx;
+           I32 arry_len=av_len(trie->words)+1;
+           PerlIO_printf(Perl_debug_log,
+                      "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%d%s]\n",
+                      (int)(2*(l+3)), "",
+                      trie->wordcount,
+                      trie->charcount,
+                      trie->uniquecharcount,
+                      trie->laststate-1,
+                      node->flags ? " EVAL mode" : "");
+
+           for (word_idx=0; word_idx < arry_len; word_idx++) {
+               SV **elem_ptr=av_fetch(trie->words,word_idx,0);
+               if (elem_ptr) {
+                   PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n",
+                      (int)(2*(l+4)), "",
+                      PL_colors[0],
+                      SvPV_nolen(*elem_ptr),
+                      PL_colors[1]
+                   );
+                   /*
+                   if (next == NULL)
+                       PerlIO_printf(Perl_debug_log, "(0)\n");
+                   else
+                       PerlIO_printf(Perl_debug_log, "(%"IVdf")\n", (IV)(next - start));
+                   */
+               }
+
+           }
+
+           node = NEXTOPER(node);
+           node += regarglen[(U8)op];
+
+       }
        else if ( op == CURLY) {   /* `next' might be very big: optimizer */
            node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
                             NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
@@ -4755,12 +5868,15 @@ Perl_regdump(pTHX_ regexp *r)
     if (r->offsets) {
       U32 i;
       U32 len = r->offsets[0];
+        GET_RE_DEBUG_FLAGS_DECL;
+        DEBUG_OFFSETS_r({
       PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
       for (i = 1; i <= len; i++)
         PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ", 
                       (UV)r->offsets[i*2-1], 
                       (UV)r->offsets[i*2]);
       PerlIO_printf(Perl_debug_log, "\n");
+        });
     }
 #endif /* DEBUGGING */
 }
@@ -4780,6 +5896,7 @@ S_put_byte(pTHX_ SV *sv, int c)
 
 #endif /* DEBUGGING */
 
+
 /*
 - regprop - printable representation of opcode
 */
@@ -4815,8 +5932,18 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
                       PL_colors[0],
                       len, s,
                       PL_colors[1]);
-    }
-    else if (k == CURLY) {
+    } else if (k == TRIE) {/*
+       this isn't always safe, as Pl_regdata may not be for this regex yet
+       (depending on where its called from) so its being moved to dumpuntil
+       I32 n = ARG(o);
+       reg_trie_data *trie=(reg_trie_data*)PL_regdata->data[n];
+       Perl_sv_catpvf(aTHX_ sv, " (W:%d L:%d C:%d S:%d)",
+                      trie->wordcount,
+                      trie->charcount,
+                      trie->uniquecharcount,
+                      trie->laststate);
+       */
+    } else if (k == CURLY) {
        if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
            Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
        Perl_sv_catpvf(aTHX_ sv, " {%d,%d}", ARG1(o), ARG2(o));
@@ -4969,7 +6096,8 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 SV *
 Perl_re_intuit_string(pTHX_ regexp *prog)
 {                              /* Assume that RE_INTUIT is set */
-    DEBUG_r(
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_COMPILE_r(
        {   STRLEN n_a;
            char *s = SvPV(prog->check_substr
                      ? prog->check_substr : prog->check_utf8, n_a);
@@ -4993,11 +6121,13 @@ Perl_pregfree(pTHX_ struct regexp *r)
 {
 #ifdef DEBUGGING
     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
+    SV *re_debug_flags=get_sv(RE_DEBUG_FLAGS,0);
 #endif
 
+
     if (!r || (--r->refcnt > 0))
        return;
-    DEBUG_r({
+    DEBUG_r(if (re_debug_flags && (SvIV(re_debug_flags) & RE_DEBUG_COMPILE)) {
         int len;
          char *s;
 
@@ -5008,7 +6138,7 @@ Perl_pregfree(pTHX_ struct regexp *r)
         if (!PL_colorset)
              reginitcolors();
         PerlIO_printf(Perl_debug_log,
-                      "%sFreeing REx:%s `%s%*.*s%s%s'\n",
+                      "%sFreeing REx:%s %s%*.*s%s%s\n",
                       PL_colors[4],PL_colors[5],PL_colors[0],
                       len, len, s,
                       PL_colors[1],
@@ -5073,6 +6203,32 @@ Perl_pregfree(pTHX_ struct regexp *r)
                break;
            case 'n':
                break;
+           case 't':
+                   {
+                       reg_trie_data *trie=(reg_trie_data*)r->data->data[n];
+                       U32 refcount;
+                       OP_REFCNT_LOCK;
+                       refcount = trie->refcount--;
+                       OP_REFCNT_UNLOCK;
+                       if ( !refcount ) {
+                           if (trie->charmap)
+                               Safefree(trie->charmap);
+                           if (trie->widecharmap)
+                               SvREFCNT_dec((SV*)trie->widecharmap);
+                           if (trie->states)
+                               Safefree(trie->states);
+                           if (trie->trans)
+                               Safefree(trie->trans);
+#ifdef DEBUGGING
+                           if (trie->words)
+                               SvREFCNT_dec((SV*)trie->words);
+                           if (trie->revcharmap)
+                               SvREFCNT_dec((SV*)trie->revcharmap);
+#endif
+                           Safefree(r->data->data[n]); /* do this last!!!! */
+                       }
+                       break;
+                   }
            default:
                Perl_croak(aTHX_ "panic: regfree data code '%c'", r->data->what[n]);
            }
@@ -5087,9 +6243,6 @@ Perl_pregfree(pTHX_ struct regexp *r)
 
 /*
  - regnext - dig the "next" pointer out of a node
- *
- * [Note, when REGALIGN is defined there are two places in regmatch()
- * that bypass this code for speed.]
  */
 regnode *
 Perl_regnext(pTHX_ register regnode *p)
index 3aa5c1e..94e54e8 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
@@ -53,7 +53,8 @@ typedef OP OP_4tree;                  /* Will be redefined later. */
  * a literal string; for others, it is a node leading into a sub-FSM.  In
  * particular, the operand of a BRANCH node is the first node of the branch.
  * (NB this is *not* a tree structure:  the tail of the branch connects
- * to the thing following the set of BRANCHes.)  The opcodes are:
+ * to the thing following the set of BRANCHes.)  The opcodes are defined
+ * in regnodes.h which is generated from regcomp.sym by regcomp.pl.
  */
 
 /*
@@ -375,6 +376,7 @@ typedef struct re_scream_pos_data_s
  *   s - swash for unicode-style character class, and the multicharacter
  *       strings resulting from casefolding the single-character entries
  *       in the character class
+ *   t - trie struct
  * 20010712 mjd@plover.com
  * (Remember to update re_dup() and pregfree() if you add any items.)
  */
@@ -406,3 +408,129 @@ struct reg_substr_data {
 #define check_utf8 substrs->data[2].utf8_substr
 #define check_offset_min substrs->data[2].min_offset
 #define check_offset_max substrs->data[2].max_offset
+
+
+
+/* trie related stuff */
+/* an accepting state/position*/
+struct _reg_trie_accepted {
+    U8   *endpos;
+    U16  wordnum;
+};
+/* a transition record for the state machine. the
+   check field determines which state "owns" the
+   transition. the char the transition is for is
+   determined by offset from the owning states base
+   field.  the next field determines which state
+   is to be transitioned to if any.
+*/
+struct _reg_trie_trans {
+  U32 next;
+  U32 check;
+};
+
+/* a transition list element for the list based representation */
+struct _reg_trie_trans_list_elem {
+    U16 forid;
+    U32 newstate;
+};
+typedef struct _reg_trie_trans_list_elem reg_trie_trans_le;
+
+/* a state for compressed nodes. base is an offset
+  into an array of reg_trie_trans array. If wordnum is
+  nonzero the state is accepting. if base is zero then
+  the state has no children (and will be accepting)
+*/
+struct _reg_trie_state {
+  U16 wordnum;
+  union {
+    U32                base;
+    reg_trie_trans_le* list;
+  } trans;
+};
+
+
+
+typedef struct _reg_trie_accepted reg_trie_accepted;
+typedef struct _reg_trie_state    reg_trie_state;
+typedef struct _reg_trie_trans    reg_trie_trans;
+
+
+/* anything in here that needs to be freed later
+should be dealt with in pregfree */
+struct _reg_trie_data {
+    U16              uniquecharcount;
+    U16              wordcount;
+    STRLEN           charcount;
+    U32              laststate;
+    U16              *charmap;
+    HV               *widecharmap;
+    reg_trie_state   *states;
+    reg_trie_trans   *trans;
+    U32              refcount;
+#ifdef DEBUGGING
+    AV               *words;
+    AV               *revcharmap;
+#endif
+};
+
+typedef struct _reg_trie_data reg_trie_data;
+
+/* these defines assume uniquecharcount is the correct variable, and state may be evaluated twice */
+#define TRIE_NODENUM(state) (((state)-1)/(trie->uniquecharcount)+1)
+#define SAFE_TRIE_NODENUM(state) ((state) ? (((state)-1)/(trie->uniquecharcount)+1) : (state))
+#define TRIE_NODEIDX(state) ((state) ? (((state)-1)*(trie->uniquecharcount)+1) : (state))
+
+#define DO_TRIE 1
+#define TRIE_DEBUG 1
+
+
+#define TRIE_SIMPLE_MAX_BUFF 65536
+#define RE_TRIE_MAXBUFF "\022E_TRIE_MAXBUFF"
+#define RE_DEBUG_FLAGS "\022E_DEBUG_FLAGS"
+
+/* If you change these be sure to update ext/re/re.pm as well */
+#define RE_DEBUG_COMPILE       1
+#define RE_DEBUG_EXECUTE       2
+#define RE_DEBUG_TRIE_COMPILE  4
+#define RE_DEBUG_TRIE_EXECUTE  8
+#define RE_DEBUG_TRIE_MORE    16
+#define RE_DEBUG_OPTIMISE     32
+#define RE_DEBUG_OFFSETS      64
+
+#define DEBUG_OPTIMISE_r(x) DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_OPTIMISE) x  )
+#define DEBUG_EXECUTE_r(x) DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_EXECUTE) x  )
+#define DEBUG_COMPILE_r(x) DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_COMPILE) x  )
+#define DEBUG_OFFSETS_r(x) DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_OFFSETS) x  )
+#define DEBUG_TRIE_r(x) DEBUG_r( \
+   if (SvIV(re_debug_flags) & RE_DEBUG_TRIE_COMPILE       \
+       || SvIV(re_debug_flags) & RE_DEBUG_TRIE_EXECUTE )  \
+   x  \
+)
+#define DEBUG_TRIE_EXECUTE_r(x) \
+    DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_TRIE_EXECUTE) x )
+
+#define DEBUG_TRIE_COMPILE_r(x) \
+    DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_TRIE_COMPILE) x )
+
+#define DEBUG_TRIE_EXECUTE_MORE_r(x) \
+    DEBUG_TRIE_EXECUTE_r( if (SvIV(re_debug_flags) & RE_DEBUG_TRIE_MORE) x )
+
+#define DEBUG_TRIE_COMPILE_MORE_r(x) \
+    DEBUG_TRIE_COMPILE_r( if (SvIV(re_debug_flags) & RE_DEBUG_TRIE_MORE) x )
+
+#define GET_RE_DEBUG_FLAGS DEBUG_r( \
+        re_debug_flags=get_sv(RE_DEBUG_FLAGS, 1); \
+        if (!SvIOK(re_debug_flags)) { \
+            sv_setiv(re_debug_flags, RE_DEBUG_COMPILE | RE_DEBUG_EXECUTE | RE_DEBUG_OFFSETS); \
+        } \
+    )
+
+
+#ifdef DEBUGGING
+#define GET_RE_DEBUG_FLAGS_DECL SV *re_debug_flags; GET_RE_DEBUG_FLAGS;
+#else
+#define GET_RE_DEBUG_FLAGS_DECL
+#endif
+
+
index 850800c..1bcdecb 100644 (file)
@@ -60,6 +60,11 @@ EXACT                EXACT,  sv      Match this string (preceded by length).
 EXACTF         EXACT,  sv      Match this string, folded (prec. by length).
 EXACTFL                EXACT,  sv      Match this string, folded in locale (w/len).
 
+# Trie Related (behave the same as A|LIST|OF|WORDS would)
+TRIE           TRIE,   trie 1  Match one or more of many EXACT strings
+TRIEF          TRIE,   trie 1  Match one or more of many EXACTF strings
+TRIEFL         TRIE,   trie 1  Match one or more of many EXACTFL strings
+
 # Do nothing
 NOTHING                NOTHING,no      Match empty string.
 # A variant of above which delimits a group, thus stops optimizations
index f254713..192396f 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -207,11 +207,11 @@ S_regcppush(pTHX_ I32 parenfloor)
 }
 
 /* These are needed since we do not localize EVAL nodes: */
-#  define REGCP_SET(cp)  DEBUG_r(PerlIO_printf(Perl_debug_log,         \
+#  define REGCP_SET(cp)  DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,         \
                             "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
                             (IV)PL_savestack_ix)); cp = PL_savestack_ix
 
-#  define REGCP_UNWIND(cp)  DEBUG_r(cp != PL_savestack_ix ?            \
+#  define REGCP_UNWIND(cp)  DEBUG_EXECUTE_r(cp != PL_savestack_ix ?            \
                                PerlIO_printf(Perl_debug_log,           \
                                "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
                                (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
@@ -224,6 +224,8 @@ S_regcppop(pTHX)
     char *input;
     I32 tmps;
 
+    GET_RE_DEBUG_FLAGS_DECL;
+
     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
     i = SSPOPINT;
     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
@@ -242,7 +244,7 @@ S_regcppop(pTHX)
        tmps = SSPOPINT;
        if (paren <= *PL_reglastparen)
            PL_regendp[paren] = tmps;
-       DEBUG_r(
+       DEBUG_EXECUTE_r(
            PerlIO_printf(Perl_debug_log,
                          "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
                          (UV)paren, (IV)PL_regstartp[paren],
@@ -251,7 +253,7 @@ S_regcppop(pTHX)
                          (paren > *PL_reglastparen ? "(no)" : ""));
        );
     }
-    DEBUG_r(
+    DEBUG_EXECUTE_r(
        if ((I32)(*PL_reglastparen + 1) <= PL_regnpar) {
            PerlIO_printf(Perl_debug_log,
                          "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
@@ -414,15 +416,18 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     char *i_strpos = strpos;
     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
 #endif
+
+    GET_RE_DEBUG_FLAGS_DECL;
+
     RX_MATCH_UTF8_set(prog,do_utf8);
 
     if (prog->reganch & ROPT_UTF8) {
-       DEBUG_r(PerlIO_printf(Perl_debug_log,
+       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                              "UTF-8 regex...\n"));
        PL_reg_flags |= RF_utf8;
     }
 
-    DEBUG_r({
+    DEBUG_EXECUTE_r({
         char *s   = PL_reg_match_utf8 ?
                         sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
                         strpos;
@@ -431,7 +436,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
         if (!PL_colorset)
              reginitcolors();
         if (PL_reg_match_utf8)
-            DEBUG_r(PerlIO_printf(Perl_debug_log,
+            DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                                   "UTF-8 target...\n"));
         PerlIO_printf(Perl_debug_log,
                       "%sGuessing start of match, REx%s `%s%.60s%s%s' against `%s%.*s%s%s'...\n",
@@ -448,7 +453,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
     /* CHR_DIST() would be more correct here but it makes things slow. */
     if (prog->minlen > strend - strpos) {
-       DEBUG_r(PerlIO_printf(Perl_debug_log,
+       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                              "String too short... [re_intuit_start]\n"));
        goto fail;
     }
@@ -464,7 +469,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        check = prog->check_substr;
     }
    if (check == &PL_sv_undef) {
-       DEBUG_r(PerlIO_printf(Perl_debug_log,
+       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                "Non-utf string cannot match utf check string\n"));
        goto fail;
     }
@@ -479,7 +484,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
               /* SvCUR is not set on references: SvRV and SvPVX overlap */
               && sv && !SvROK(sv)
               && (strpos != strbeg)) {
-             DEBUG_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
+             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
              goto fail;
          }
          if (prog->check_offset_min == prog->check_offset_max &&
@@ -493,7 +498,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
                if ( strend - s > slen || strend - s < slen - 1
                     || (strend - s == slen && strend[-1] != '\n')) {
-                   DEBUG_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
+                   DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
                    goto fail_finish;
                }
                /* Now should match s[0..slen-2] */
@@ -502,7 +507,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                             || (slen > 1
                                 && memNE(SvPVX(check), s, slen)))) {
                  report_neq:
-                   DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
+                   DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
                    goto fail_finish;
                }
            }
@@ -574,7 +579,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     /* Update the count-of-usability, remove useless subpatterns,
        unshift s.  */
 
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s %s substr `%s%.*s%s'%s%s",
+    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s %s substr `%s%.*s%s'%s%s",
                          (s ? "Found" : "Did not find"),
                          (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"),
                          PL_colors[0],
@@ -589,7 +594,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     check_at = s;
 
     /* Finish the diagnostic message */
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
+    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
 
     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
        Start with the other substr.
@@ -630,7 +635,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
                if (must == &PL_sv_undef) {
                    s = (char*)NULL;
-                   DEBUG_r(must = prog->anchored_utf8);        /* for debug */
+                   DEBUG_EXECUTE_r(must = prog->anchored_utf8);        /* for debug */
                }
                else
                    s = fbm_instr(
@@ -640,7 +645,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                        must,
                        multiline ? FBMrf_MULTILINE : 0
                    );
-               DEBUG_r(PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                        "%s anchored substr `%s%.*s%s'%s",
                        (s ? "Found" : "Contradicts"),
                        PL_colors[0],
@@ -650,11 +655,11 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                          PL_colors[1], (SvTAIL(must) ? "$" : "")));
                if (!s) {
                    if (last1 >= last2) {
-                       DEBUG_r(PerlIO_printf(Perl_debug_log,
+                       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                                                ", giving up...\n"));
                        goto fail_finish;
                    }
-                   DEBUG_r(PerlIO_printf(Perl_debug_log,
+                   DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                        ", trying floating at offset %ld...\n",
                        (long)(HOP3c(s1, 1, strend) - i_strpos)));
                    other_last = HOP3c(last1, prog->anchored_offset+1, strend);
@@ -662,7 +667,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                    goto restart;
                }
                else {
-                   DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
+                   DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
                          (long)(s - i_strpos)));
                    t = HOP3c(s, -prog->anchored_offset, strbeg);
                    other_last = HOP3c(s, 1, strend);
@@ -693,14 +698,14 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
               and end-of-str is not later than strend we are OK. */
            if (must == &PL_sv_undef) {
                s = (char*)NULL;
-               DEBUG_r(must = prog->float_utf8);       /* for debug message */
+               DEBUG_EXECUTE_r(must = prog->float_utf8);       /* for debug message */
            }
            else
                s = fbm_instr((unsigned char*)s,
                              (unsigned char*)last + SvCUR(must)
                                  - (SvTAIL(must)!=0),
                              must, multiline ? FBMrf_MULTILINE : 0);
-           DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
+           DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
                    (s ? "Found" : "Contradicts"),
                    PL_colors[0],
                      (int)(SvCUR(must) - (SvTAIL(must)!=0)),
@@ -708,11 +713,11 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                      PL_colors[1], (SvTAIL(must) ? "$" : "")));
            if (!s) {
                if (last1 == last) {
-                   DEBUG_r(PerlIO_printf(Perl_debug_log,
+                   DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                                            ", giving up...\n"));
                    goto fail_finish;
                }
-               DEBUG_r(PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                    ", trying anchored starting at offset %ld...\n",
                    (long)(s1 + 1 - i_strpos)));
                other_last = last;
@@ -720,7 +725,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                goto restart;
            }
            else {
-               DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
+               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
                      (long)(s - i_strpos)));
                other_last = s; /* Fix this later. --Hugo */
                s = s1;
@@ -759,33 +764,33 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                               is float.  Redo checking for "other"=="fixed".
                             */
                            strpos = t + 1;                     
-                           DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
+                           DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
                                PL_colors[0],PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
                            goto do_other_anchored;
                        }
                        /* We don't contradict the found floating substring. */
                        /* XXXX Why not check for STCLASS? */
                        s = t + 1;
-                       DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
+                       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
                            PL_colors[0],PL_colors[1], (long)(s - i_strpos)));
                        goto set_useful;
                    }
                    /* Position contradicts check-string */
                    /* XXXX probably better to look for check-string
                       than for "\n", so one should lower the limit for t? */
-                   DEBUG_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
+                   DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
                        PL_colors[0],PL_colors[1], (long)(t + 1 - i_strpos)));
                    other_last = strpos = s = t + 1;
                    goto restart;
                }
                t++;
            }
-           DEBUG_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
+           DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
                        PL_colors[0],PL_colors[1]));
            goto fail_finish;
        }
        else {
-           DEBUG_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
+           DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
                        PL_colors[0],PL_colors[1]));
        }
        s = t;
@@ -808,7 +813,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            t = strpos;
            goto find_anchor;
        }
-       DEBUG_r( if (ml_anch)
+       DEBUG_EXECUTE_r( if (ml_anch)
            PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
                        (long)(strpos - i_strpos), PL_colors[0],PL_colors[1]);
        );
@@ -825,7 +830,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            )))
        {
            /* If flags & SOMETHING - do not do it many times on the same match */
-           DEBUG_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
+           DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
            SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
            if (do_utf8 ? prog->check_substr : prog->check_utf8)
                SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
@@ -873,29 +878,29 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            char *what = 0;
 #endif
            if (endpos == strend) {
-               DEBUG_r( PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                                "Could not match STCLASS...\n") );
                goto fail;
            }
-           DEBUG_r( PerlIO_printf(Perl_debug_log,
+           DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                                   "This position contradicts STCLASS...\n") );
            if ((prog->reganch & ROPT_ANCH) && !ml_anch)
                goto fail;
            /* Contradict one of substrings */
            if (prog->anchored_substr || prog->anchored_utf8) {
                if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
-                   DEBUG_r( what = "anchored" );
+                   DEBUG_EXECUTE_r( what = "anchored" );
                  hop_and_restart:
                    s = HOP3c(t, 1, strend);
                    if (s + start_shift + end_shift > strend) {
                        /* XXXX Should be taken into account earlier? */
-                       DEBUG_r( PerlIO_printf(Perl_debug_log,
+                       DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                                               "Could not match STCLASS...\n") );
                        goto fail;
                    }
                    if (!check)
                        goto giveup;
-                   DEBUG_r( PerlIO_printf(Perl_debug_log,
+                   DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                                "Looking for %s substr starting at offset %ld...\n",
                                 what, (long)(s + start_shift - i_strpos)) );
                    goto restart;
@@ -907,7 +912,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                s = check_at;
                if (!check)
                    goto giveup;
-               DEBUG_r( PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                          "Looking for anchored substr starting at offset %ld...\n",
                          (long)(other_last - i_strpos)) );
                goto do_other_anchored;
@@ -918,7 +923,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                s = t = t + 1;
                if (!check)
                    goto giveup;
-               DEBUG_r( PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                          "Looking for /%s^%s/m starting at offset %ld...\n",
                          PL_colors[0],PL_colors[1], (long)(t - i_strpos)) );
                goto try_at_offset;
@@ -928,23 +933,23 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
            /* Check is floating subtring. */
          retry_floating_check:
            t = check_at - start_shift;
-           DEBUG_r( what = "floating" );
+           DEBUG_EXECUTE_r( what = "floating" );
            goto hop_and_restart;
        }
        if (t != s) {
-            DEBUG_r(PerlIO_printf(Perl_debug_log,
+            DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                        "By STCLASS: moving %ld --> %ld\n",
                                   (long)(t - i_strpos), (long)(s - i_strpos))
                    );
         }
         else {
-            DEBUG_r(PerlIO_printf(Perl_debug_log,
+            DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                                   "Does not contradict STCLASS...\n"); 
                    );
         }
     }
   giveup:
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
+    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
                          PL_colors[4], (check ? "Guessed" : "Giving up"),
                          PL_colors[5], (long)(s - i_strpos)) );
     return s;
@@ -953,7 +958,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     if (prog->check_substr || prog->check_utf8)                /* could be removed already */
        BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
   fail:
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
+    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
                          PL_colors[4],PL_colors[5]));
     return Nullch;
 }
@@ -1640,6 +1645,9 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
 #endif
+
+    GET_RE_DEBUG_FLAGS_DECL;
+
     RX_MATCH_UTF8_set(prog,do_utf8);
 
     PL_regcc = 0;
@@ -1657,7 +1665,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 
     minlen = prog->minlen;
     if (strend - startpos < minlen) {
-        DEBUG_r(PerlIO_printf(Perl_debug_log,
+        DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                              "String too short [regexec_flags]...\n"));
        goto phooey;
     }
@@ -1718,12 +1726,12 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
        d.scream_pos = &scream_pos;
        s = re_intuit_start(prog, sv, s, strend, flags, &d);
        if (!s) {
-           DEBUG_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
+           DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
            goto phooey;        /* not present */
        }
     }
 
-    DEBUG_r({
+    DEBUG_EXECUTE_r({
         char *s0   = UTF ?
           pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
                          UNI_DISPLAY_REGEX) :
@@ -1811,7 +1819,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
        if (do_utf8) {
            while (s < strend) {
                if (*s == ch) {
-                   DEBUG_r( did_match = 1 );
+                   DEBUG_EXECUTE_r( did_match = 1 );
                    if (regtry(prog, s)) goto got_it;
                    s += UTF8SKIP(s);
                    while (s < strend && *s == ch)
@@ -1823,7 +1831,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
        else {
            while (s < strend) {
                if (*s == ch) {
-                   DEBUG_r( did_match = 1 );
+                   DEBUG_EXECUTE_r( did_match = 1 );
                    if (regtry(prog, s)) goto got_it;
                    s++;
                    while (s < strend && *s == ch)
@@ -1832,7 +1840,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                s++;
            }
        }
-       DEBUG_r(if (!did_match)
+       DEBUG_EXECUTE_r(if (!did_match)
                PerlIO_printf(Perl_debug_log,
                                   "Did not find anchored character...\n")
                );
@@ -1890,7 +1898,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            /* we may be pointing at the wrong string */
            if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
                s = strbeg + (s - SvPVX(sv));
-           DEBUG_r( did_match = 1 );
+           DEBUG_EXECUTE_r( did_match = 1 );
            if (HOPc(s, -back_max) > last1) {
                last1 = HOPc(s, -back_min);
                s = HOPc(s, -back_max);
@@ -1916,7 +1924,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                }
            }
        }
-       DEBUG_r(if (!did_match)
+       DEBUG_EXECUTE_r(if (!did_match)
                     PerlIO_printf(Perl_debug_log, 
                                   "Did not find %s substr `%s%.*s%s'%s...\n",
                              ((must == prog->anchored_substr || must == prog->anchored_utf8)
@@ -1935,7 +1943,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            if (PL_regkind[op] != EXACT && op != CANY)
                strend = HOPc(strend, -(minlen - 1));
        }
-       DEBUG_r({
+       DEBUG_EXECUTE_r({
            SV *prop = sv_newmortal();
            char *s0;
            char *s1;
@@ -1958,7 +1966,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
        });
        if (find_byclass(prog, c, s, strend, startpos, 0))
            goto got_it;
-       DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
+       DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
     }
     else {
        dontbother = 0;
@@ -2001,7 +2009,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                }
            }
            if (last == NULL) {
-               DEBUG_r(PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                                      "%sCan't trim the tail, match fails (should not happen)%s\n",
                                      PL_colors[4],PL_colors[5]));
                goto phooey; /* Should not happen! */
@@ -2078,7 +2086,7 @@ got_it:
     return 1;
 
 phooey:
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
+    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
                          PL_colors[4],PL_colors[5]));
     if (PL_reg_eval_set)
        restore_pos(aTHX_ 0);
@@ -2095,6 +2103,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
     register I32 *sp;
     register I32 *ep;
     CHECKPOINT lastcp;
+    GET_RE_DEBUG_FLAGS_DECL;
 
 #ifdef DEBUGGING
     PL_regindent = 0;  /* XXXX Not good when matches are reenterable... */
@@ -2103,7 +2112,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
        MAGIC *mg;
 
        PL_reg_eval_set = RS_init;
-       DEBUG_r(DEBUG_s(
+       DEBUG_EXECUTE_r(DEBUG_s(
            PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
                          (IV)(PL_stack_sp - PL_stack_base));
            ));
@@ -2175,7 +2184,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos)
     prog->lastparen = 0;
     prog->lastcloseparen = 0;
     PL_regsize = 0;
-    DEBUG_r(PL_reg_starttry = startpos);
+    DEBUG_EXECUTE_r(PL_reg_starttry = startpos);
     if (PL_reg_start_tmpl <= prog->nparens) {
        PL_reg_start_tmpl = prog->nparens*3/2 + 3;
         if(PL_reg_start_tmp)
@@ -2256,7 +2265,68 @@ typedef union re_unwind_t {
 #define sayNO_SILENT goto do_no
 #define saySAME(x) if (x) goto yes; else goto no
 
-#define REPORT_CODE_OFF 24
+/* this is used to determine how far from the left messages like
+   'failed...' are printed. Currently 29 makes these messages line
+   up with the opcode they refer to. Earlier perls used 25 which
+   left these messages outdented making reviewing a debug output
+   quite difficult.
+*/
+#define REPORT_CODE_OFF 29
+
+
+/* Make sure there is a test for this +1 options in re_tests */
+#define TRIE_INITAL_ACCEPT_BUFFLEN 4;
+
+#define TRIE_CHECK_STATE_IS_ACCEPTING STMT_START {                       \
+    if ( trie->states[ state ].wordnum ) {                               \
+       if ( !accepted ) {                                               \
+           ENTER;                                                       \
+           SAVETMPS;                                                    \
+           bufflen = TRIE_INITAL_ACCEPT_BUFFLEN ;                       \
+           sv_accept_buff=NEWSV( 1234,                                  \
+             bufflen * sizeof(reg_trie_accepted) - 1 );                 \
+           SvCUR_set( sv_accept_buff, sizeof(reg_trie_accepted) );      \
+           SvPOK_on( sv_accept_buff );                                  \
+           sv_2mortal( sv_accept_buff );                                \
+           accept_buff = (reg_trie_accepted*)SvPV_nolen( sv_accept_buff );\
+       } else {                                                         \
+           if ( accepted >= bufflen ) {                                 \
+               bufflen *= 2;                                            \
+               accept_buff =(reg_trie_accepted*)SvGROW( sv_accept_buff, \
+                   bufflen * sizeof(reg_trie_accepted) );               \
+           }                                                            \
+           SvCUR_set( sv_accept_buff,SvCUR( sv_accept_buff )            \
+               + sizeof( reg_trie_accepted ) );                         \
+       }                                                                \
+       accept_buff[ accepted ].wordnum = trie->states[ state ].wordnum; \
+       accept_buff[ accepted ].endpos = uc;                             \
+       ++accepted;                                                      \
+    } } STMT_END
+
+#define TRIE_HANDLE_CHAR STMT_START {                                   \
+        if ( uvc < 256 ) {                                              \
+            charid = trie->charmap[ uvc ];                              \
+        } else {                                                        \
+            charid = 0;                                                 \
+            if( trie->widecharmap ) {                                   \
+            SV** svpp = (SV**)NULL;                                     \
+            svpp = hv_fetch( trie->widecharmap, (char*)&uvc,            \
+                         sizeof( UV ), 0 );                            \
+            if ( svpp ) {                                               \
+               charid = (U16)SvIV( *svpp );                            \
+                }                                                       \
+            }                                                           \
+        }                                                               \
+        if ( charid &&                                                  \
+             ( base + charid - 1 - trie->uniquecharcount ) >=0  &&      \
+             trie->trans[ base + charid - 1 - trie->uniquecharcount ].check == state ) \
+        {                                                               \
+            state = trie->trans[ base + charid - 1 - trie->uniquecharcount ].next;     \
+        } else {                                                        \
+            state = 0;                                                  \
+        }                                                               \
+        uc += len;                                                      \
+    } STMT_END
 
 /*
  - regmatch - main matching routine
@@ -2287,6 +2357,13 @@ S_regmatch(pTHX_ regnode *prog)
     register I32 c1 = 0, c2 = 0, paren;        /* case fold search, parenth */
     int minmod = 0, sw = 0, logical = 0;
     I32 unwind = 0;
+
+    /* used by the trie code */
+    SV                 *sv_accept_buff;  /* accepting states we have traversed */
+    reg_trie_accepted  *accept_buff;     /* "" */
+    reg_trie_data      *trie;            /* what trie are we using right now */
+    U32 accepted = 0;                    /* how many accepting states we have seen*/
+
 #if 0
     I32 firstcp = PL_savestack_ix;
 #endif
@@ -2295,18 +2372,23 @@ S_regmatch(pTHX_ regnode *prog)
     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
+
+    SV *re_debug_flags;
 #endif
 
+    GET_RE_DEBUG_FLAGS;
+
 #ifdef DEBUGGING
     PL_regindent++;
 #endif
 
+
     /* Note that nextchr is a byte even in UTF */
     nextchr = UCHARAT(locinput);
     scan = prog;
     while (scan != NULL) {
 
-        DEBUG_r( {
+        DEBUG_EXECUTE_r( {
            SV *prop = sv_newmortal();
            int docolor = *PL_colors[0];
            int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
@@ -2444,6 +2526,231 @@ S_regmatch(pTHX_ regnode *prog)
            else
                nextchr = UCHARAT(++locinput);
            break;
+
+
+
+       /*
+          traverse the TRIE keeping track of all accepting states
+          we transition through until we get to a failing node.
+
+          we use two slightly different pieces of code to handle
+          the traversal depending on whether its case sensitive or
+          not. we reuse the accept code however. (this should probably
+          be turned into a macro.)
+
+       */
+       case TRIEF:
+       case TRIEFL:
+           {
+
+               U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY;
+               U8 *uc = ( U8* )locinput;
+               U32 state = 1;
+               U16 charid = 0;
+               U32 base = 0;
+               UV uvc = 0;
+               STRLEN len = 0;
+               STRLEN foldlen = 0;
+               U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+               U8 *uscan = (U8*)NULL;
+               STRLEN bufflen=0;
+               accepted = 0;
+
+               trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
+
+               while ( state && uc <= (U8*)PL_regeol ) {
+
+                   TRIE_CHECK_STATE_IS_ACCEPTING;
+
+                   base = trie->states[ state ].trans.base;
+
+                   DEBUG_TRIE_EXECUTE_r(
+                               PerlIO_printf( Perl_debug_log,
+                                   "%*s  %sState: %4x, Base: %4x Accepted: %4x ",
+                                   REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
+                                   state, base, accepted );
+                   );
+
+                   if ( base ) {
+
+                       if ( do_utf8 || UTF ) {
+                           if ( foldlen>0 ) {
+                               uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
+                               foldlen -= len;
+                               uscan += len;
+                               len=0;
+                           } else {
+                               uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
+                               uvc = to_uni_fold( uvc, foldbuf, &foldlen );
+                               foldlen -= UNISKIP( uvc );
+                               uscan = foldbuf + UNISKIP( uvc );
+                           }
+                       } else {
+                           uvc = (U32)*uc;
+                           len = 1;
+                       }
+
+                       TRIE_HANDLE_CHAR;
+
+                   } else {
+                       state = 0;
+                   }
+                   DEBUG_TRIE_EXECUTE_r(
+                               PerlIO_printf( Perl_debug_log,
+                                   "Charid:%3x CV:%4x After State: %4x%s\n",
+                                   charid, uvc, state, PL_colors[5] );
+                   );
+               }
+               if ( !accepted ) {
+                  sayNO;
+               } else {
+                   goto TrieAccept;
+               }
+           }
+           /* unreached codepoint: we jump into the middle of the next case
+              from previous if blocks */
+       case TRIE:
+           {
+               U32 uniflags = ckWARN( WARN_UTF8 ) ? 0 : UTF8_ALLOW_ANY;
+               U8 *uc = (U8*)locinput;
+               U32 state = 1;
+               U16 charid = 0;
+               U32 base = 0;
+               UV uvc = 0;
+               STRLEN len = 0;
+               STRLEN bufflen = 0;
+               accepted = 0;
+
+               trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
+
+               while ( state && uc <= (U8*)PL_regeol ) {
+
+                   TRIE_CHECK_STATE_IS_ACCEPTING;
+
+                   base = trie->states[ state ].trans.base;
+
+                   DEBUG_TRIE_EXECUTE_r(
+                           PerlIO_printf( Perl_debug_log,
+                               "%*s  %sState: %4x, Base: %4x Accepted: %4x ",
+                               REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
+                               state, base, accepted );
+                   );
+
+                   if ( base ) {
+
+                       if ( do_utf8 || UTF ) {
+                           uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
+                       } else {
+                           uvc = (U32)*uc;
+                           len = 1;
+                       }
+
+                        TRIE_HANDLE_CHAR;
+
+                   } else {
+                       state = 0;
+                   }
+                   DEBUG_TRIE_EXECUTE_r(
+                           PerlIO_printf( Perl_debug_log,
+                               "Charid:%3x CV:%4x After State: %4x%s\n",
+                               charid, uvc, state, PL_colors[5] );
+                   );
+               }
+               if ( !accepted ) {
+                  sayNO;
+               }
+           }
+
+
+           /*
+              There was at least one accepting state that we
+              transitioned through. Presumably the number of accepting
+              states is going to be low, typically one or two. So we
+              simply scan through to find the one with lowest wordnum.
+              Once we find it, we swap the last state into its place
+              and decrement the size. We then try to match the rest of
+              the pattern at the point where the word ends, if we
+              succeed then we end the loop, otherwise the loop
+              eventually terminates once all of the accepting states
+              have been tried.
+           */
+       TrieAccept:
+           {
+               int gotit = 0;
+
+               if ( accepted == 1 ) {
+                   DEBUG_EXECUTE_r({
+                        SV **tmp = av_fetch( trie->words, accept_buff[ 0 ].wordnum-1, 0 );
+                               PerlIO_printf( Perl_debug_log,
+                           "%*s  %sonly one match : #%d <%s>%s\n",
+                           REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],
+                           accept_buff[ 0 ].wordnum,
+                           tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr",
+                           PL_colors[5] );
+                   });
+                   PL_reginput = accept_buff[ 0 ].endpos;
+                   /* in this case we free tmps/leave before we call regmatch
+                      as we wont be using accept_buff again. */
+                   FREETMPS;
+                   LEAVE;
+                   gotit = regmatch( scan + NEXT_OFF( scan ) );
+               } else {
+                    DEBUG_EXECUTE_r(
+                        PerlIO_printf( Perl_debug_log,"%*s  %sgot %d possible matches%s\n",
+                            REPORT_CODE_OFF + PL_regindent * 2, "",PL_colors[4], accepted,
+                            PL_colors[5] );
+                    );
+                   while ( !gotit && accepted-- ) {
+                       U32 best = 0;
+                       U32 cur;
+                       for( cur = 1 ; cur <= accepted ; cur++ ) {
+                            DEBUG_TRIE_EXECUTE_r(
+                                       PerlIO_printf( Perl_debug_log,
+                                           "%*s  %sgot %d (%d) as best, looking at %d (%d)%s\n",
+                                           REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
+                                           best, accept_buff[ best ].wordnum, cur,
+                                           accept_buff[ cur ].wordnum, PL_colors[5] );
+                            );
+
+                           if ( accept_buff[ cur ].wordnum < accept_buff[ best ].wordnum )
+                                   best = cur;
+                       }
+                       DEBUG_EXECUTE_r({
+                           SV **tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 );
+                           PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
+                               REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],
+                               accept_buff[best].wordnum,
+                               tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr",scan,
+                               PL_colors[5] );
+                       });
+                       if ( best<accepted ) {
+                           reg_trie_accepted tmp = accept_buff[ best ];
+                           accept_buff[ best ] = accept_buff[ accepted ];
+                           accept_buff[ accepted ] = tmp;
+                           best = accepted;
+                       }
+                       PL_reginput = accept_buff[ best ].endpos;
+
+                        /* 
+                           as far as I can tell we only need the SAVETMPS/FREETMPS 
+                           for re's with EVAL in them but I'm leaving them in for 
+                           all until I can be sure.
+                         */
+                       SAVETMPS;
+                       gotit = regmatch( scan + NEXT_OFF( scan ) ) ;
+                       FREETMPS;
+                   }
+                   FREETMPS;
+                   LEAVE;
+               }
+               
+               if ( gotit ) {
+                   sayYES;
+               } else {
+                   sayNO;
+               }
+           }
+           /* unreached codepoint */
        case EXACT:
            s = STRING(scan);
            ln = STR_LEN(scan);
@@ -2859,7 +3166,7 @@ S_regmatch(pTHX_ regnode *prog)
        
            n = ARG(scan);
            PL_op = (OP_4tree*)PL_regdata->data[n];
-           DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
+           DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
            PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
            PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
 
@@ -2920,7 +3227,7 @@ S_regmatch(pTHX_ regnode *prog)
                        PL_regsize = osize;
                        PL_regnpar = onpar;
                    }
-                   DEBUG_r(
+                   DEBUG_EXECUTE_r(
                        PerlIO_printf(Perl_debug_log,
                                      "Entering embedded `%s%.60s%s%s'\n",
                                      PL_colors[0],
@@ -3146,7 +3453,7 @@ S_regmatch(pTHX_ regnode *prog)
                n = cc->cur + 1;        /* how many we know we matched */
                PL_reginput = locinput;
 
-               DEBUG_r(
+               DEBUG_EXECUTE_r(
                    PerlIO_printf(Perl_debug_log,
                                  "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
                                  REPORT_CODE_OFF+PL_regindent*2, "",
@@ -3160,7 +3467,7 @@ S_regmatch(pTHX_ regnode *prog)
                    PL_regcc = cc->oldcc;
                    if (PL_regcc)
                        ln = PL_regcc->cur;
-                   DEBUG_r(
+                   DEBUG_EXECUTE_r(
                        PerlIO_printf(Perl_debug_log,
                           "%*s  empty match detected, try continuation...\n",
                           REPORT_CODE_OFF+PL_regindent*2, "")
@@ -3206,7 +3513,7 @@ S_regmatch(pTHX_ regnode *prog)
                        PL_reg_poscache_size = size;
                        Newz(29, PL_reg_poscache, size, char);
                    }
-                   DEBUG_r(
+                   DEBUG_EXECUTE_r(
                        PerlIO_printf(Perl_debug_log,
              "%sDetected a super-linear match, switching on caching%s...\n",
                                      PL_colors[4], PL_colors[5])
@@ -3219,7 +3526,7 @@ S_regmatch(pTHX_ regnode *prog)
                    b = o % 8;
                    o /= 8;
                    if (PL_reg_poscache[o] & (1<<b)) {
-                   DEBUG_r(
+                   DEBUG_EXECUTE_r(
                        PerlIO_printf(Perl_debug_log,
                                      "%*s  already tried at this position...\n",
                                      REPORT_CODE_OFF+PL_regindent*2, "")
@@ -3262,7 +3569,7 @@ S_regmatch(pTHX_ regnode *prog)
                        sayNO;
                    }
 
-                   DEBUG_r(
+                   DEBUG_EXECUTE_r(
                        PerlIO_printf(Perl_debug_log,
                                      "%*s  trying longer...\n",
                                      REPORT_CODE_OFF+PL_regindent*2, "")
@@ -3298,7 +3605,7 @@ S_regmatch(pTHX_ regnode *prog)
                    REGCP_UNWIND(lastcp);
                    regcppop();         /* Restore some previous $<digit>s? */
                    PL_reginput = locinput;
-                   DEBUG_r(
+                   DEBUG_EXECUTE_r(
                        PerlIO_printf(Perl_debug_log,
                                      "%*s  failed, try continuation...\n",
                                      REPORT_CODE_OFF+PL_regindent*2, "")
@@ -3452,7 +3759,7 @@ S_regmatch(pTHX_ regnode *prog)
            else {
                n = regrepeat_hard(scan, n, &l);
                locinput = PL_reginput;
-               DEBUG_r(
+               DEBUG_EXECUTE_r(
                    PerlIO_printf(Perl_debug_log,
                                  "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
                                  (int)(REPORT_CODE_OFF+PL_regindent*2), "",
@@ -3491,7 +3798,7 @@ S_regmatch(pTHX_ regnode *prog)
                        UCHARAT(PL_reginput) == c1 ||
                        UCHARAT(PL_reginput) == c2)
                    {
-                       DEBUG_r(
+                       DEBUG_EXECUTE_r(
                                PerlIO_printf(Perl_debug_log,
                                              "%*s  trying tail with n=%"IVdf"...\n",
                                              (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
@@ -3825,7 +4132,7 @@ S_regmatch(pTHX_ regnode *prog)
                PL_reg_re = re;
                cache_re(re);
 
-               DEBUG_r(
+               DEBUG_EXECUTE_r(
                    PerlIO_printf(Perl_debug_log,
                                  "%*s  continuation failed...\n",
                                  REPORT_CODE_OFF+PL_regindent*2, "")
@@ -3833,7 +4140,7 @@ S_regmatch(pTHX_ regnode *prog)
                sayNO_SILENT;
            }
            if (locinput < PL_regtill) {
-               DEBUG_r(PerlIO_printf(Perl_debug_log,
+               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
                                      "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
                                      PL_colors[4],
                                      (long)(locinput - PL_reg_starttry),
@@ -3923,14 +4230,14 @@ S_regmatch(pTHX_ regnode *prog)
     sayNO;
 
 yes_loud:
-    DEBUG_r(
+    DEBUG_EXECUTE_r(
        PerlIO_printf(Perl_debug_log,
                      "%*s  %scould match...%s\n",
                      REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
        );
     goto yes;
 yes_final:
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
+    DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
                          PL_colors[4],PL_colors[5]));
 yes:
 #ifdef DEBUGGING
@@ -3944,7 +4251,7 @@ yes:
     return 1;
 
 no:
-    DEBUG_r(
+    DEBUG_EXECUTE_r(
        PerlIO_printf(Perl_debug_log,
                      "%*s  %sfailed...%s\n",
                      REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
@@ -4239,15 +4546,17 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
        c = scan - PL_reginput;
     PL_reginput = scan;
 
-    DEBUG_r(
-       {
+    DEBUG_r({
+               SV *re_debug_flags;
                SV *prop = sv_newmortal();
-
+                GET_RE_DEBUG_FLAGS;
+                DEBUG_EXECUTE_r({
                regprop(prop, p);
                PerlIO_printf(Perl_debug_log,
                              "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
                              REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
        });
+       });
 
     return(c);
 }
index d9dbabe..0a1111f 100644 (file)
 #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 #n. */
-#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        OPTIMIZED       61      /* 0x3d Placeholder for dump. */
+#define        TRIE    36      /* 0x24 Match one or more of many EXACT strings */
+#define        TRIEF   37      /* 0x25 Match one or more of many EXACTF strings */
+#define        TRIEFL  38      /* 0x26 Match one or more of many EXACTFL strings */
+#define        NOTHING 39      /* 0x27 Match empty string. */
+#define        TAIL    40      /* 0x28 Match empty string. Can jump here from outside. */
+#define        STAR    41      /* 0x29 Match this (simple) thing 0 or more times. */
+#define        PLUS    42      /* 0x2a Match this (simple) thing 1 or more times. */
+#define        CURLY   43      /* 0x2b Match this simple thing {n,m} times. */
+#define        CURLYN  44      /* 0x2c Match next-after-this simple thing  */
+#define        CURLYM  45      /* 0x2d Match this medium-complex thing {n,m} times. */
+#define        CURLYX  46      /* 0x2e Match this complex thing {n,m} times. */
+#define        WHILEM  47      /* 0x2f Do curly processing and see if rest matches. */
+#define        OPEN    48      /* 0x30 Mark this point in input as start of #n. */
+#define        CLOSE   49      /* 0x31 Analogous to OPEN. */
+#define        REF     50      /* 0x32 Match some already matched string */
+#define        REFF    51      /* 0x33 Match already matched string, folded */
+#define        REFFL   52      /* 0x34 Match already matched string, folded in loc. */
+#define        IFMATCH 53      /* 0x35 Succeeds if the following matches. */
+#define        UNLESSM 54      /* 0x36 Fails if the following matches. */
+#define        SUSPEND 55      /* 0x37 "Independent" sub-RE. */
+#define        IFTHEN  56      /* 0x38 Switch, should be preceeded by switcher . */
+#define        GROUPP  57      /* 0x39 Whether the group matched. */
+#define        LONGJMP 58      /* 0x3a Jump far away. */
+#define        BRANCHJ 59      /* 0x3b BRANCH with long offset. */
+#define        EVAL    60      /* 0x3c Execute some Perl code. */
+#define        MINMOD  61      /* 0x3d Next operator is not greedy. */
+#define        LOGICAL 62      /* 0x3e Next opcode should set the flag only. */
+#define        RENUM   63      /* 0x3f Group with independently numbered parens. */
+#define        OPTIMIZED       64      /* 0x40 Placeholder for dump. */
 
 #ifndef DOINIT
 EXTCONST U8 PL_regkind[];
@@ -106,6 +109,9 @@ EXTCONST U8 PL_regkind[] = {
        EXACT,          /* EXACT */
        EXACT,          /* EXACTF */
        EXACT,          /* EXACTFL */
+       TRIE,           /* TRIE */
+       TRIE,           /* TRIEF */
+       TRIE,           /* TRIEFL */
        NOTHING,                /* NOTHING */
        NOTHING,                /* TAIL */
        STAR,           /* STAR */
@@ -174,6 +180,9 @@ static const U8 regarglen[] = {
        0,              /* EXACT */
        0,              /* EXACTF */
        0,              /* EXACTFL */
+       EXTRA_SIZE(struct regnode_1),           /* TRIE */
+       EXTRA_SIZE(struct regnode_1),           /* TRIEF */
+       EXTRA_SIZE(struct regnode_1),           /* TRIEFL */
        0,              /* NOTHING */
        0,              /* TAIL */
        0,              /* STAR */
@@ -239,6 +248,9 @@ static const char reg_off_by_arg[] = {
        0,              /* EXACT */
        0,              /* EXACTF */
        0,              /* EXACTFL */
+       0,              /* TRIE */
+       0,              /* TRIEF */
+       0,              /* TRIEFL */
        0,              /* NOTHING */
        0,              /* TAIL */
        0,              /* STAR */
@@ -305,35 +317,38 @@ static const char * const reg_name[] = {
        "EXACT",                /* 0x21 */
        "EXACTF",               /* 0x22 */
        "EXACTFL",              /* 0x23 */
-       "NOTHING",              /* 0x24 */
-       "TAIL",         /* 0x25 */
-       "STAR",         /* 0x26 */
-       "PLUS",         /* 0x27 */
-       "CURLY",                /* 0x28 */
-       "CURLYN",               /* 0x29 */
-       "CURLYM",               /* 0x2a */
-       "CURLYX",               /* 0x2b */
-       "WHILEM",               /* 0x2c */
-       "OPEN",         /* 0x2d */
-       "CLOSE",                /* 0x2e */
-       "REF",          /* 0x2f */
-       "REFF",         /* 0x30 */
-       "REFFL",                /* 0x31 */
-       "IFMATCH",              /* 0x32 */
-       "UNLESSM",              /* 0x33 */
-       "SUSPEND",              /* 0x34 */
-       "IFTHEN",               /* 0x35 */
-       "GROUPP",               /* 0x36 */
-       "LONGJMP",              /* 0x37 */
-       "BRANCHJ",              /* 0x38 */
-       "EVAL",         /* 0x39 */
-       "MINMOD",               /* 0x3a */
-       "LOGICAL",              /* 0x3b */
-       "RENUM",                /* 0x3c */
-       "OPTIMIZED",            /* 0x3d */
+       "TRIE",         /* 0x24 */
+       "TRIEF",                /* 0x25 */
+       "TRIEFL",               /* 0x26 */
+       "NOTHING",              /* 0x27 */
+       "TAIL",         /* 0x28 */
+       "STAR",         /* 0x29 */
+       "PLUS",         /* 0x2a */
+       "CURLY",                /* 0x2b */
+       "CURLYN",               /* 0x2c */
+       "CURLYM",               /* 0x2d */
+       "CURLYX",               /* 0x2e */
+       "WHILEM",               /* 0x2f */
+       "OPEN",         /* 0x30 */
+       "CLOSE",                /* 0x31 */
+       "REF",          /* 0x32 */
+       "REFF",         /* 0x33 */
+       "REFFL",                /* 0x34 */
+       "IFMATCH",              /* 0x35 */
+       "UNLESSM",              /* 0x36 */
+       "SUSPEND",              /* 0x37 */
+       "IFTHEN",               /* 0x38 */
+       "GROUPP",               /* 0x39 */
+       "LONGJMP",              /* 0x3a */
+       "BRANCHJ",              /* 0x3b */
+       "EVAL",         /* 0x3c */
+       "MINMOD",               /* 0x3d */
+       "LOGICAL",              /* 0x3e */
+       "RENUM",                /* 0x3f */
+       "OPTIMIZED",            /* 0x40 */
 };
 
-static const int reg_num = 62;
+static const int reg_num = 65;
 
 #endif /* DEBUGGING */
 #endif /* REG_COMP_C */
diff --git a/sv.c b/sv.c
index 98fd4c6..b62969c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10238,6 +10238,8 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
        for (i = 0; i < count; i++) {
            d->what[i] = r->data->what[i];
            switch (d->what[i]) {
+               /* legal options are one of: sfpont
+                  see also regcomp.h and pregfree() */
            case 's':
                d->data[i] = sv_dup_inc((SV *)r->data->data[i], param);
                break;
@@ -10261,6 +10263,14 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
            case 'n':
                d->data[i] = r->data->data[i];
                break;
+           case 't':
+               d->data[i] = r->data->data[i];
+               OP_REFCNT_LOCK;
+               ((reg_trie_data*)d->data[i])->refcount++;
+               OP_REFCNT_UNLOCK;
+               break;
+            default:
+               Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'", r->data->what[i]);
            }
        }
 
index b257b47..ce5d7a2 100755 (executable)
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..1065\n";
+print "1..1178\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3285,4 +3285,83 @@ ok(("abc" =~ /^abc(\z)?/) && defined($1),
 ok(("abc" =~ /^abc(\z)??/) && !defined($1),
     'optional zero-width match at end of string');
 
-# last test 1065
+
+
+{ # TRIE related
+    my @got=();
+    "words"=~/(word|word|word)(?{push @got,$1})s$/;
+    ok(@got==1,"TRIE optimation is working") or warn "# @got";
+    @got=();
+    "words"=~/(word|word|word)(?{push @got,$1})s$/i;
+    ok(@got==1,"TRIEF optimisation is working") or warn "# @got";
+
+    my @nums=map {int rand 1000} 1..100;
+    my $re="(".(join "|",@nums).")";
+    $re=qr/\b$re\b/;
+
+    foreach (@nums) {
+        ok($_=~/$re/,"Trie nums");
+    }
+    $_=join " ", @nums;
+    @got=();
+    push @got,$1 while /$re/g;
+
+    my %count;
+    $count{$_}++ for @got;
+    my $ok=1;
+    for (@nums) {
+        $ok=0 if --$count{$_}<0;
+    }
+    ok($ok,"Trie min count matches");
+}
+
+
+# TRIE related
+# LATIN SMALL/CAPITAL LETTER A WITH MACRON
+ok(("foba  \x{101}foo" =~ qr/(foo|\x{100}foo|bar)/i) && $1 eq "\x{101}foo",
+   "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH MACRON");
+
+# LATIN SMALL/CAPITAL LETTER A WITH RING BELOW
+ok(("foba  \x{1E01}foo" =~ qr/(foo|\x{1E00}foo|bar)/i) && $1 eq "\x{1E01}foo",
+   "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH RING BELOW");
+
+# DESERET SMALL/CAPITAL LETTER LONG I
+ok(("foba  \x{10428}foo" =~ qr/(foo|\x{10400}foo|bar)/i) &&  $1 eq "\x{10428}foo",
+   "TRIEF + DESERET SMALL/CAPITAL LETTER LONG I");
+
+# LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'
+ok(("foba  \x{1E01}xfoo" =~ qr/(foo|\x{1E00}Xfoo|bar)/i) &&  $1 eq "\x{1E01}xfoo",
+   "TRIEF + LATIN SMALL/CAPITAL LETTER A WITH RING BELOW + 'X'");
+
+{# TRIE related
+
+use charnames ':full';
+
+$s="\N{LATIN SMALL LETTER SHARP S}";
+ok(("foba  ba$s" =~ qr/(foo|Ba$s|bar)/i)
+    &&  $1 eq "ba$s",
+   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
+ok(("foba  ba$s" =~ qr/(Ba$s|foo|bar)/i)
+    &&  $1 eq "ba$s",
+   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
+ok(("foba  ba$s" =~ qr/(foo|bar|Ba$s)/i)
+    &&  $1 eq "ba$s",
+   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
+
+ok(("foba  ba$s" =~ qr/(foo|Bass|bar)/i)
+    &&  $1 eq "ba$s",
+   "TRIEF + LATIN SMALL LETTER SHARP S =~ ss");
+
+ok(("foba  ba$s" =~ qr/(foo|BaSS|bar)/i)
+    &&  $1 eq "ba$s",
+   "TRIEF + LATIN SMALL LETTER SHARP S =~ SS");
+}
+
+
+
+{
+    my @normal=qw(these are some normal words);
+    my $psycho=join "|",@normal,map chr $_,255..20000;
+    ok(('these'=~/($psycho)/) && $1 eq 'these','Pyscho');
+}
+# last test 1178
index 1bec50b..b7fbf2d 100644 (file)
@@ -943,3 +943,16 @@ a(b)??     abc     y       <$1>    <>      # undef [perl #16773]
 .*a(?!(b|cd)*e).*f     ......abef      n       -       -       # [perl #23030]
 x(?#   x       c       -       Sequence (?#... not terminated
 :x(?#: x       c       -       Sequence (?#... not terminated
+(WORDS|WORD)S  WORDS   y       $1      WORD
+(X.|WORDS|X.|WORD)S    WORDS   y       $1      WORD
+(WORDS|WORLD|WORD)S    WORDS   y       $1      WORD
+(X.|WORDS|WORD|Y.)S    WORDS   y       $1      WORD
+(foo|fool|x.|money|parted)$    fool    y       $1      fool
+(x.|foo|fool|x.|money|parted|y.)$      fool    y       $1      fool
+(foo|fool|money|parted)$       fool    y       $1      fool
+(foo|fool|x.|money|parted)$    fools   n       -       -
+(x.|foo|fool|x.|money|parted|y.)$      fools   n       -       -
+(foo|fool|money|parted)$       fools   n       -       -
+(a|aa|aaa|aaaa|aaaaa|aaaaaa)(b|c)      aaaaaaaaaaaaaaab        y       $1$2    aaaaaab
+(a|aa|aaa|aaaa|aaaaa|aaaaaa)(??{$1&&""})(b|c)  aaaaaaaaaaaaaaab        y       $1$2    aaaaaab
+(a|aa|aaa|aaaa|aaaaa|aaaaaa)(??{$1&&"foo"})(b|c)       aaaaaaaaaaaaaaab        n       -       -
index ee64122..a56c5b2 100755 (executable)
@@ -24,7 +24,7 @@ closedir(OP);
 ## This range will have to adjust as the number of tests expands,
 ## as it's counting the number of .t files in src/t
 ##
-my ($min, $max) = (115, 135);
+my ($min, $max) = (125, 145);
 if (@D > $min && @D < $max) { print "ok 2\n"; }
 else {
     printf "not ok 2 # counting op/*.t, expect $min < %d < $max files\n",
diff --git a/t/op/regexp_notrie.t b/t/op/regexp_notrie.t
new file mode 100644 (file)
index 0000000..28681da
--- /dev/null
@@ -0,0 +1,15 @@
+#!./perl
+#use re 'debug';
+BEGIN {
+    ${^RE_TRIE_MAXBUFF}=-1;
+    #${^RE_DEBUG_FLAGS}=0;
+}
+
+$qr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+    if (-r $file) {
+       do $file;
+       exit;
+    }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";
diff --git a/t/op/regexp_trielist.t b/t/op/regexp_trielist.t
new file mode 100644 (file)
index 0000000..22f4f58
--- /dev/null
@@ -0,0 +1,15 @@
+#!./perl
+#use re 'debug';
+BEGIN {
+        ${^RE_TRIE_MAXBUFF}=0;
+        #${^RE_DEBUG_FLAGS}=0;
+      }
+
+$qr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+    if (-r $file) {
+       do $file;
+       exit;
+    }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";