This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] More regex optimisations and debug enhancements (including Andys stuff...
authorYves Orton <demerphq@gmail.com>
Sun, 28 May 2006 16:24:59 +0000 (18:24 +0200)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Mon, 29 May 2006 12:38:09 +0000 (12:38 +0000)
Message-ID: <9b18b3110605280724u54a9c53bn3b20692b6fe4f1c3@mail.gmail.com>

p4raw-id: //depot/perl@28325

MANIFEST
embed.fnc
ext/re/re.pm
ext/re/t/regop.pl [new file with mode: 0644]
ext/re/t/regop.t [new file with mode: 0644]
regcomp.c
regcomp.h
regcomp.pl
regcomp.sym
regexec.c
t/op/re_tests

index b677bfb..b527b9c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1008,6 +1008,8 @@ ext/re/re.pm                      re extension Perl module
 ext/re/re_top.h                        re extension symbol hiding header
 ext/re/re.xs                   re extension external subroutines
 ext/re/t/re.t                  see if re pragma works
+ext/re/t/regop.pl              generate debug output for various patterns
+ext/re/t/regop.t               test RE optimizations by scraping debug output
 ext/Safe/t/safe1.t             See if Safe works
 ext/Safe/t/safe2.t             See if Safe works
 ext/Safe/t/safe3.t             See if Safe works
index 2050be8..edb4458 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1284,25 +1284,20 @@ s       |SV *   |space_join_names_mortal|NN char *const *array
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
-Es     |regnode*|reg           |NN struct RExC_state_t *state|I32 paren|NN I32 *flagp
+Es     |regnode*|reg           |NN struct RExC_state_t *state|I32 paren|NN I32 *flagp|U32 depth
 Es     |regnode*|reganode      |NN struct RExC_state_t *state|U8 op|U32 arg
-Es     |regnode*|regatom       |NN struct RExC_state_t *state|NN I32 *flagp
-Es     |regnode*|regbranch     |NN struct RExC_state_t *state|NN I32 *flagp|I32 first
+Es     |regnode*|regatom       |NN struct RExC_state_t *state|NN I32 *flagp|U32 depth
+Es     |regnode*|regbranch     |NN struct RExC_state_t *state|NN I32 *flagp|I32 first|U32 depth
 Es     |STRLEN |reguni         |NN const struct RExC_state_t *state|UV uv|NN char *s
-Es     |regnode*|regclass      |NN struct RExC_state_t *state
+Es     |regnode*|regclass      |NN struct RExC_state_t *state|U32 depth
 ERsn   |I32    |regcurly       |NN const char *
 Es     |regnode*|reg_node      |NN struct RExC_state_t *state|U8 op
-Es     |regnode*|regpiece      |NN struct RExC_state_t *state|NN I32 *flagp
+Es     |regnode*|regpiece      |NN struct RExC_state_t *state|NN I32 *flagp|U32 depth
 Es     |void   |reginsert      |NN struct RExC_state_t *state|U8 op|NN regnode *opnd
-Es     |void   |regtail        |NN const struct RExC_state_t *state|NN regnode *p|NN const regnode *val
+Es     |void   |regtail        |NN struct RExC_state_t *state|NN regnode *p|NN const regnode *val|U32 depth
+Es     |U8     |regtail_study  |NN struct RExC_state_t *state|NN regnode *p|NN const regnode *val|U32 depth
 EsRn   |char*  |regwhite       |NN char *p|NN const char *e
 Es     |char*  |nextchar       |NN struct RExC_state_t *state
-#  ifdef DEBUGGING
-Es     |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \
-                               |NN const regnode *node \
-                               |NULLOK const regnode *last|NN SV* sv|I32 l
-Es     |void   |put_byte       |NN SV* sv|int c
-#  endif
 Es     |void   |scan_commit    |NN const struct RExC_state_t* state|NN struct scan_data_t *data
 Esn    |void   |cl_anything    |NN const struct RExC_state_t* state|NN struct regnode_charclass_class *cl
 EsRn   |int    |cl_is_anything |NN const struct regnode_charclass_class *cl
@@ -1319,10 +1314,18 @@ EsRn    |I32    |add_data       |NN struct RExC_state_t* state|I32 n|NN const char *s
 rs     |void   |re_croak2      |NN const char* pat1|NN const char* pat2|...
 Es     |I32    |regpposixcc    |NN struct RExC_state_t* state|I32 value
 Es     |void   |checkposixcc   |NN struct RExC_state_t* state
-
 Es     |I32    |make_trie      |NN struct RExC_state_t* state|NN regnode *startbranch \
                                |NN regnode *first|NN regnode *last|NN regnode *tail \
-                               |U32 flags
+                               |U32 flags|U32 depth
+#  ifdef DEBUGGING
+Es     |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \
+                               |NN const regnode *node \
+                               |NULLOK const regnode *last|NN SV* sv|I32 l
+Es     |void   |put_byte       |NN SV* sv|int c
+Es     |void   |dump_trie      |NN const struct _reg_trie_data *trie|U32 depth
+Es     |void   |dump_trie_interim_list|NN const struct _reg_trie_data *trie|U32 next_alloc|U32 depth
+Es     |void   |dump_trie_interim_table|NN const struct _reg_trie_data *trie|U32 next_alloc|U32 depth
+#  endif
 #endif
 
 #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT)
index fc78451..2da3a25 100644 (file)
@@ -83,13 +83,15 @@ 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
+
+    RE_DEBUG_COMPILE       0x01
+    RE_DEBUG_EXECUTE       0x02
+    RE_DEBUG_TRIE_COMPILE  0x04
+    RE_DEBUG_TRIE_EXECUTE  0x08
+    RE_DEBUG_TRIE_MORE     0x10
+    RE_DEBUG_OPTIMISE      0x20
+    RE_DEBUG_OFFSETS       0x40
+    RE_DEBUG_PARSE         0x80
 
 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
@@ -129,7 +131,8 @@ my %flags = (
     OPTIMISE     => 32,
     OPTIMIZE     => 32, # alias
     OFFSETS      => 64,
-    ALL          => 127,
+    PARSE        => 128,
+    ALL          => 255,
     All          => 15,
     More         => 31,
 );
@@ -159,6 +162,8 @@ sub bits {
                 if ($flags{$_[$idx]}) {
                     if ($on) {
                         ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
+                        ${^RE_DEBUG_FLAGS} |= 1
+                                if $flags{$_[$idx]}>2;
                     } else {
                         ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
                     }
diff --git a/ext/re/t/regop.pl b/ext/re/t/regop.pl
new file mode 100644 (file)
index 0000000..05a34ad
--- /dev/null
@@ -0,0 +1,16 @@
+use re Debug=>qw(COMPILE EXECUTE);
+my @tests=(
+  XY     =>  'X(A|[B]Q||C|D)Y' ,
+  foobar =>  '[f][o][o][b][a][r]',
+  x  =>  '.[XY].',
+  'ABCD' => '(?:ABCP|ABCG|ABCE|ABCB|ABCA|ABCD)',
+);
+while (@tests) {
+    my ($str,$pat)=splice @tests,0,2;
+    warn "\n";
+    # string eval to get the free regex message in the right place.
+    eval qq[
+        warn "$str"=~/$pat/ ? "%MATCHED%" : "%FAILED%","\n";
+    ];
+    die $@ if $@;
+}
diff --git a/ext/re/t/regop.t b/ext/re/t/regop.t
new file mode 100644 (file)
index 0000000..5947980
--- /dev/null
@@ -0,0 +1,149 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config;
+       if (($Config::Config{'extensions'} !~ /\bre\b/) ){
+               print "1..0 # Skip -- Perl configured without re module\n";
+               exit 0;
+       }
+}
+
+use strict;
+use Test::More;
+
+chomp(my @strs=grep { !/^\s*\#/ } <DATA>);
+chdir "../ext/re/t" or die "Can't chdir '../ext/re/t':$!\n";
+my $out=`$^X regop.pl 2>&1`;
+my @tests=grep { /\S/ } split /(?=Compiling REx)/,$out;
+
+plan tests => 2+(@strs-grep { !$_ or /^---/ } @strs)+@tests;
+
+my $numtests=4;
+ok(@tests==$numtests,"Expecting output for $numtests patterns");
+ok(defined $out,'regop.pl');
+$out||="";
+my $test=1;
+foreach my $testout (@tests) {
+    my ($pattern)=$testout=~/Compiling REx "([^"]+)"/;
+    ok($pattern,"Pattern for test ".($test++));
+    while (@strs) {    
+        my $str=shift @strs;
+        last if !$str or $str=~/^---/;
+        next if $str=~/^\s*#/;
+        ok($testout=~/\Q$str\E/,"$str: /$pattern/");    
+    }    
+}    
+
+__END__
+#Compiling REx "X(A|[B]Q||C|D)Y"
+#size 34
+#first at 1
+#   1: EXACT <X>(3)
+#   3: OPEN1(5)
+#   5:   TRIE-EXACT(21)
+#        [Words:5 Chars:5 Unique:5 States:6 Start-Class:A-D]
+#          <A>
+#          <BQ>
+#          <>
+#          <C>
+#          <D>
+#  21: CLOSE1(23)
+#  23: EXACT <Y>(25)
+#  25: END(0)
+#anchored "X" at 0 floating "Y" at 1..3 (checking floating) minlen 2
+#Guessing start of match, REx "X(A|[B]Q||C|D)Y" against "XY"...
+#Found floating substr "Y" at offset 1...
+#Found anchored substr "X" at offset 0...
+#Guessed: match at offset 0
+#Matching REx "X(A|[B]Q||C|D)Y" against "XY"
+#  Setting an EVAL scope, savestack=140
+#   0 <> <XY>              |  1:  EXACT <X>
+#   1 <X> <Y>              |  3:  OPEN1
+#   1 <X> <Y>              |  5:  TRIE-EXACT
+#                                 matched empty string...
+#   1 <X> <Y>              | 21:  CLOSE1
+#   1 <X> <Y>              | 23:  EXACT <Y>
+#   2 <XY> <>              | 25:  END
+#Match successful!
+#%MATCHED%
+#Freeing REx: "X(A|[B]Q||C|D)Y"
+Compiling REx "X(A|[B]Q||C|D)Y"
+Start-Class:A-D]
+TRIE-EXACT
+<BQ>
+matched empty string
+Match successful!
+Found floating substr "Y" at offset 1...
+Found anchored substr "X" at offset 0...
+Guessed: match at offset 0
+checking floating
+minlen 2
+Words:5
+Unique:5
+States:6
+%MATCHED%
+---
+#Compiling REx "[f][o][o][b][a][r]"
+#size 67
+#first at 1
+#   1: EXACT <foobar>(13)
+#  13: END(0)
+#anchored "foobar" at 0 (checking anchored isall) minlen 6
+#Guessing start of match, REx "[f][o][o][b][a][r]" against "foobar"...
+#Found anchored substr "foobar" at offset 0...
+#Guessed: match at offset 0
+#Freeing REx: "[f][o][o][b][a][r]"
+foobar
+checking anchored isall
+minlen 6
+anchored "foobar" at 0
+Guessed: match at offset 0
+Compiling REx "[f][o][o][b][a][r]"
+Freeing REx: "[f][o][o][b][a][r]"
+%MATCHED%
+---
+#Compiling REx ".[XY]."
+#size 14
+#first at 1
+#   1: REG_ANY(2)
+#   2: ANYOF[XY](13)
+#  13: REG_ANY(14)
+#  14: END(0)
+#minlen 3
+#%FAILED%
+#Freeing REx: ".[XY]."
+%FAILED%
+minlen 3
+---
+#Compiling REx "(?:ABCP|ABCG|ABCE|ABCB|ABCA|ABCD)"
+#size 20 nodes
+#   1: EXACT <ABC>(3)
+#   3: TRIE-EXACT(20)
+#      [Start:4 Words:6 Chars:24 Unique:7 States:10 Minlen:1 Maxlen:1 Start-Class:A-EGP]
+#        <ABCP>
+#        <ABCG>
+#        <ABCE>
+#        <ABCB>
+#        <ABCA>
+#        <ABCD>
+#  19: TAIL(20)
+#  20: END(0)
+#minlen 4
+#Matching REx "(?:ABCP|ABCG|ABCE|ABCB|ABCA|ABCD)" against "ABCD"
+#  Setting an EVAL scope, savestack=140
+#   0 <> <ABCD>            |  1:  EXACT <ABC>
+#   3 <ABC> <D>            |  3:  TRIE-EXACT
+#                                 only one match : #6 <ABCD>
+#   4 <ABCD> <>            | 20:    END
+#Match successful!
+#POP STATE(1)
+#%MATCHED%
+#Freeing REx: "(?:ABCP|ABCG|ABCE|ABCB|ABCA|ABCD)"
+%MATCHED%
+EXACT <ABC>
+Start-Class:A-EGP
+only one match : #6 <ABCD>
+Start:4
+minlen 4
index 7849bd3..6f56929 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -122,6 +122,12 @@ typedef struct RExC_state_t {
     char       *starttry;              /* -Dr: where regtry was called. */
 #define RExC_starttry  (pRExC_state->starttry)
 #endif
+#ifdef DEBUGGING
+    char        *lastparse;
+    I32         lastnum;
+#define RExC_lastparse (pRExC_state->lastparse)
+#define RExC_lastnum   (pRExC_state->lastnum)
+#endif
 } RExC_state_t;
 
 #define RExC_flags     (pRExC_state->flags)
@@ -160,6 +166,8 @@ typedef struct RExC_state_t {
 #define        SPSTART         0x4     /* Starts with * or +. */
 #define TRYAGAIN       0x8     /* Weeded out a declaration. */
 
+#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
+
 /* Length of a variant. */
 
 typedef struct scan_data_t {
@@ -613,7 +621,7 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con
 
 /*
 
- make_trie(startbranch,first,last,tail,flags)
+ make_trie(startbranch,first,last,tail,flags,depth)
   startbranch: the first branch in the whole branch sequence
   first      : start branch of sequence of branch-exact nodes.
               May be the same as startbranch
@@ -621,6 +629,7 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con
               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)/
+  depth      : indent depth
 
 Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
 
@@ -721,19 +730,18 @@ and would end up looking like:
    8: EXACT <baz>(10)
   10: END(0)
 
+    d = uvuni_to_utf8_flags(d, uv, 0);
+
+is the recommended Unicode-aware way of saying
+
+    *(d++) = uv;
 */
 
-#define TRIE_DEBUG_CHAR                                                    \
-    DEBUG_TRIE_COMPILE_r({                                                 \
-       SV *tmp;                                                           \
-       if ( UTF ) {                                                       \
-           tmp = newSVpvs( "" );                                          \
-           pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX );         \
-       } else {                                                           \
-           tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc );               \
-       }                                                                  \
-       av_push( trie->revcharmap, tmp );                                  \
-    })
+#define TRIE_STORE_REVCHAR                                                    \
+    STMT_START {                                                           \
+       SV *tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc );               \
+       av_push( TRIE_REVCHARMAP(trie), tmp );                             \
+    } STMT_END
 
 #define TRIE_READ_CHAR STMT_START {                                           \
     if ( UTF ) {                                                              \
@@ -782,8 +790,215 @@ and would end up looking like:
      TRIE_LIST_LEN( state ) = 4;                                \
 } STMT_END
 
+#define TRIE_HANDLE_WORD(state) STMT_START {                           \
+           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;                                            \
+                   if (OP(noper) != NOTHING )                          \
+                       tmp=newSVpvn( STRING( noper ), STR_LEN( noper ) );\
+                   else                                                \
+                       tmp=newSVpvn( "", 0 );                          \
+                   if ( UTF ) SvUTF8_on( tmp );                        \
+                   av_push( trie->words, tmp );                        \
+               });                                                     \
+           } else {                                                    \
+               NOOP;   /* It's a dupe. So ignore it. */                \
+           }                                                           \
+} STMT_END
+
+#ifdef DEBUGGING
+/* 
+   dump_trie(trie)
+   dump_trie_interim_list(trie,next_alloc)
+   dump_trie_interim_table(trie,next_alloc)
+
+   These routines dump out a trie in a somewhat readable format.
+   The _interim_ variants are used for debugging the interim 
+   tables that are used to generate the final compressed 
+   representation which is what dump_trie expects. 
+   
+   Part of the reason for their existance is to provide a form
+   of documentation as to how the different representations function.
+   
+*/   
+
+/*
+  dump_trie(trie)
+  Dumps the final compressed table form of the trie to Perl_debug_log.
+  Used for debugging make_trie().
+*/
+STATIC void
+S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth)
+{
+    U32 state;
+    GET_RE_DEBUG_FLAGS_DECL;
+
+    PerlIO_printf( Perl_debug_log, "%*sChar : %-6s%-6s%-4s ",
+        (int)depth * 2 + 2,"",
+        "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_const( *tmp ) );
+        }
+    }
+    PerlIO_printf( Perl_debug_log, "\n%*sState|-----------------------",
+        (int)depth * 2 + 2,"");
+
+    for( state = 0 ; state < trie->uniquecharcount ; state++ )
+        PerlIO_printf( Perl_debug_log, "-----");
+    PerlIO_printf( Perl_debug_log, "\n");
+
+    for( state = 1 ; state < TRIE_LASTSTATE(trie) ; state++ ) {
+    const U32 base = trie->states[ state ].trans.base;
+
+        PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
+
+        if ( trie->states[ state ].wordnum ) {
+            PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
+        } else {
+            PerlIO_printf( Perl_debug_log, "%6s", "" );
+        }
+
+        PerlIO_printf( Perl_debug_log, " @%4"UVXf" ", (UV)base );
+
+        if ( base ) {
+            U32 ofs = 0;
+
+            while( ( base + ofs  < trie->uniquecharcount ) ||
+                   ( base + ofs - trie->uniquecharcount < trie->lasttrans
+                     && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
+                    ofs++;
+
+            PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
+
+            for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
+                if ( ( base + ofs >= trie->uniquecharcount ) &&
+                     ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
+                     trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
+                {
+                   PerlIO_printf( Perl_debug_log, "%4"UVXf" ",
+                    (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
+                } else {
+                    PerlIO_printf( Perl_debug_log, "%4s ","   ." );
+                }
+            }
+
+            PerlIO_printf( Perl_debug_log, "]");
+
+        }
+        PerlIO_printf( Perl_debug_log, "\n" );
+    }
+}    
+/*
+  dump_trie_interim_list(trie,next_alloc)
+  Dumps a fully constructed but uncompressed trie in list form.
+  List tries normally only are used for construction when the number of 
+  possible chars (trie->uniquecharcount) is very high.
+  Used for debugging make_trie().
+*/
+STATIC void
+S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc,U32 depth)
+{
+    U32 state;
+    GET_RE_DEBUG_FLAGS_DECL;
+    /* print out the table precompression.  */
+    PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s",
+        (int)depth * 2 + 2,"", (int)depth * 2 + 2,"");
+    PerlIO_printf( Perl_debug_log,   "------:-----+-----------------" );
+    
+    for( state=1 ; state < next_alloc ; state ++ ) {
+        U16 charid;
+    
+        PerlIO_printf( Perl_debug_log, "\n%*s %4"UVXf" :",
+            (int)depth * 2 + 2,"", (UV)state  );
+        if ( ! trie->states[ state ].wordnum ) {
+            PerlIO_printf( Perl_debug_log, "%5s| ","");
+        } else {
+            PerlIO_printf( Perl_debug_log, "W%4x| ",
+                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=%4"UVXf" | ",
+                SvPV_nolen_const( *tmp ),
+                TRIE_LIST_ITEM(state,charid).forid,
+                (UV)TRIE_LIST_ITEM(state,charid).newstate
+            );
+        }
+    
+    }
+}    
+
+/*
+  dump_trie_interim_table(trie,next_alloc)
+  Dumps a fully constructed but uncompressed trie in table form.
+  This is the normal DFA style state transition table, with a few 
+  twists to facilitate compression later. 
+  Used for debugging make_trie().
+*/
+STATIC void
+S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc, U32 depth)
+{
+    U32 state;
+    U16 charid;
+    GET_RE_DEBUG_FLAGS_DECL;
+    
+    /*
+       print out the table precompression so that we can do a visual check
+       that they are identical.
+     */
+    
+    PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
+
+    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_const( *tmp ) );
+        }
+    }
+
+    PerlIO_printf( Perl_debug_log, "\n%*sState+-",(int)depth * 2 + 2,"" );
+
+    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, "%*s%4"UVXf" : ", 
+            (int)depth * 2 + 2,"",
+            (UV)TRIE_NODENUM( state ) );
+
+        for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
+            PerlIO_printf( Perl_debug_log, "%4"UVXf" ",
+                (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
+        }
+        if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
+            PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
+        } else {
+            PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
+            trie->states[ TRIE_NODENUM( state ) ].wordnum );
+        }
+    }
+}    
+
+#endif
+
+
+
+
+
 STATIC I32
-S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags)
+S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags, U32 depth)
 {
     dVAR;
     /* first pass, loop through and scan words */
@@ -805,24 +1020,44 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 
     const U32 data_slot = add_data( pRExC_state, 1, "t" );
     SV *re_trie_maxbuff;
-
+#ifndef DEBUGGING
+    /* these are only used during construction but are useful during
+    debugging so we store them in the struct when debugging.
+    Wordcount is actually superfluous in debugging as we have
+    (AV*)trie->words to use for it, but thats not available when
+    not debugging... We could make the macro use the AV during
+    debugging tho...
+    */
+    U16 trie_wordcount=0;
+    STRLEN trie_charcount=0;
+    U32 trie_laststate=0;
+    AV *trie_revcharmap;
+#endif
     GET_RE_DEBUG_FLAGS_DECL;
 
     Newxz( trie, 1, reg_trie_data );
     trie->refcount = 1;
+    trie->startstate = 1;
     RExC_rx->data->data[ data_slot ] = (void*)trie;
     Newxz( trie->charmap, 256, U16 );
+    if (!(UTF && folder))
+        Newxz( trie->bitmap, ANYOF_BITMAP_SIZE, char );
     DEBUG_r({
         trie->words = newAV();
-        trie->revcharmap = newAV();
     });
-
+    TRIE_REVCHARMAP(trie) = newAV();
 
     re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
     if (!SvIOK(re_trie_maxbuff)) {
         sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
     }
-
+    DEBUG_OPTIMISE_r({
+                PerlIO_printf( Perl_debug_log,
+                  "%*smake_trie start==%d, first==%d, last==%d, tail==%d\n", 
+                  (int)depth * 2 + 2, "", 
+                  REG_NODE_NUM(startbranch),REG_NODE_NUM(first), 
+                  REG_NODE_NUM(last), REG_NODE_NUM(tail));
+    });
     /*  -- First loop and Setup --
 
        We first traverse the branches and scan each word to determine if it
@@ -846,7 +1081,6 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 
      */
 
-
     for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
         regnode * const noper = NEXTOPER( cur );
         const U8 *uc = (U8*)STRING( noper );
@@ -854,16 +1088,27 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         STRLEN foldlen = 0;
         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
         const U8 *scan = (U8*)NULL;
+        STRLEN chars=0;
 
+        TRIE_WORDCOUNT(trie)++;
+        if (OP(noper) == NOTHING) {
+            trie->minlen= 0;
+            continue;
+        }
+        if (trie->bitmap) {
+            TRIE_BITMAP_SET(trie,*uc);
+            if ( folder ) TRIE_BITMAP_SET(trie,folder[ *uc ]);            
+        }
         for ( ; uc < e ; uc += len ) {
-            trie->charcount++;
+            TRIE_CHARCOUNT(trie)++;
             TRIE_READ_CHAR;
+            chars++;
             if ( uvc < 256 ) {
                 if ( !trie->charmap[ uvc ] ) {
                     trie->charmap[ uvc ]=( ++trie->uniquecharcount );
                     if ( folder )
                         trie->charmap[ folder[ uvc ] ] = trie->charmap[ uvc ];
-                    TRIE_DEBUG_CHAR;
+                    TRIE_STORE_REVCHAR;
                 }
             } else {
                 SV** svpp;
@@ -877,16 +1122,25 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 
                 if ( !SvTRUE( *svpp ) ) {
                     sv_setiv( *svpp, ++trie->uniquecharcount );
-                    TRIE_DEBUG_CHAR;
+                    TRIE_STORE_REVCHAR;
                 }
             }
         }
-        trie->wordcount++;
+        if( cur == first ) {
+            trie->minlen=chars;
+            trie->maxlen=chars;
+        } else if (chars < trie->minlen) {
+            trie->minlen=chars;
+        } else if (chars > trie->maxlen) {
+            trie->maxlen=chars;
+        }
+
     } /* 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,
-                (int)trie->charcount, trie->uniquecharcount )
+        PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
+                (int)depth * 2 + 2,"",
+                ( trie->widecharmap ? "UTF8" : "NATIVE" ), TRIE_WORDCOUNT(trie),
+                (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, trie->minlen, trie->maxlen )
     );
 
 
@@ -912,7 +1166,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
     */
 
 
-    if ( (IV)( ( trie->charcount + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
+    if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
         /*
             Second Pass -- Array Of Lists Representation
 
@@ -923,14 +1177,11 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
             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;
 
-        Newxz( trie->states, trie->charcount + 2, reg_trie_state );
+        Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
         TRIE_LIST_NEW(1);
         next_alloc = 2;
 
@@ -945,6 +1196,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
            STRLEN foldlen   = 0;         /* required init */
            U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
 
+            if (OP(noper) != NOTHING) {
            for ( ; uc < e ; uc += len ) {
 
                TRIE_READ_CHAR;
@@ -985,58 +1237,18 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                }
                /* 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 {
-               NOOP;   /* It's a dupe. So ignore it. */
            }
+            TRIE_HANDLE_WORD(state);
 
         } /* end second pass */
 
-        trie->laststate = next_alloc;
+        TRIE_LASTSTATE(trie) = next_alloc;
         Renew( trie->states, next_alloc, reg_trie_state );
 
-        DEBUG_TRIE_COMPILE_MORE_r({
-            U32 state;
-
-            /* 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 ++ ) {
-               U16 charid;
-
-                PerlIO_printf( Perl_debug_log, "\n %04"UVXf" :", (UV)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=%04"UVXf" | ",
-                        SvPV_nolen_const( *tmp ),
-                        TRIE_LIST_ITEM(state,charid).forid,
-                        (UV)TRIE_LIST_ITEM(state,charid).newstate
+        /* and now dump it out before we compress it */
+        DEBUG_TRIE_COMPILE_MORE_r(
+            dump_trie_interim_list(trie,next_alloc,depth+1)
                     );
-                }
-
-            }
-            PerlIO_printf( Perl_debug_log, "\n\n" );
-        });
 
         Newxz( trie->trans, transcount ,reg_trie_trans );
         {
@@ -1146,11 +1358,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 
         */
 
-        Newxz( trie->trans, ( trie->charcount + 1 ) * trie->uniquecharcount + 1,
+
+        Newxz( trie->trans, ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1,
               reg_trie_trans );
-        Newxz( trie->states, trie->charcount + 2, reg_trie_state );
+        Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state );
         next_alloc = trie->uniquecharcount + 1;
 
+
         for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
 
            regnode * const noper   = NEXTOPER( cur );
@@ -1166,7 +1380,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
             STRLEN foldlen   = 0;         /* required init */
             U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
 
-
+            if ( OP(noper) != NOTHING ) {
             for ( ; uc < e ; uc += len ) {
 
                 TRIE_READ_CHAR;
@@ -1190,66 +1404,17 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                 }
                 /* 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 {
-               NOOP;  /* Its a dupe. So ignore it. */
             }
+            accept_state = TRIE_NODENUM( state );
+            TRIE_HANDLE_WORD(accept_state);
 
         } /* 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_const( *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, "%04"UVXf" : ", (UV)TRIE_NODENUM( state ) );
+        /* and now dump it out before we compress it */
+        DEBUG_TRIE_COMPILE_MORE_r(
+            dump_trie_interim_table(trie,next_alloc,depth+1)
+        );
 
-                for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
-                    PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
-                        (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
-                }
-                if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
-                    PerlIO_printf( Perl_debug_log, " (%04"UVXf")\n", (UV)trie->trans[ state ].check );
-                } else {
-                    PerlIO_printf( Perl_debug_log, " (%04"UVXf") W%04X\n", (UV)trie->trans[ state ].check,
-                    trie->states[ TRIE_NODENUM( state ) ].wordnum );
-                }
-            }
-            PerlIO_printf( Perl_debug_log, "\n\n" );
-        });
         {
         /*
            * Inplace compress the table.*
@@ -1314,7 +1479,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         const U32 laststate = TRIE_NODENUM( next_alloc );
        U32 state, charid;
         U32 pos = 0, zp=0;
-        trie->laststate = laststate;
+        TRIE_LASTSTATE(trie) = laststate;
 
         for ( state = 1 ; state < laststate ; state++ ) {
             U8 flag = 0;
@@ -1354,8 +1519,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         Renew( trie->states, laststate + 1, reg_trie_state);
         DEBUG_TRIE_COMPILE_MORE_r(
                 PerlIO_printf( Perl_debug_log,
-                   " Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
-                   (int)( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ),
+                   "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+                   (int)depth * 2 + 2,"",
+                    (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
                    (IV)next_alloc,
                    (IV)pos,
                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
@@ -1366,98 +1532,129 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
     /* resize the trans array to remove unused space */
     Renew( trie->trans, trie->lasttrans, reg_trie_trans);
 
-    DEBUG_TRIE_COMPILE_r({
-        U32 state;
+    /* and now dump out the compressed format */
+    DEBUG_TRIE_COMPILE_r(
+        dump_trie(trie,depth+1)
+    );
+    
+    {   /* Modify the program and insert the new TRIE node*/ 
+        regnode *convert;
+        U8 nodetype =(U8)(flags & 0xFF);
+        char *str=NULL;
         /*
-           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.
+           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.
          */
-        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_const( *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++ ) {
-           const U32 base = trie->states[ state ].trans.base;
-
-            PerlIO_printf( Perl_debug_log, "#%04"UVXf" ", (UV)state);
-
-            if ( trie->states[ state ].wordnum ) {
-                PerlIO_printf( Perl_debug_log, " W%04X", trie->states[ state ].wordnum );
+        /* Find the node we are going to overwrite */
+        if ( first == startbranch && OP( last ) != BRANCH ) {
+            convert = first;
             } else {
-                PerlIO_printf( Perl_debug_log, "%6s", "" );
+            convert = NEXTOPER( first );
+            NEXT_OFF( first ) = (U16)(last - first);
             }
 
-            PerlIO_printf( Perl_debug_log, " @%04"UVXf" ", (UV)base );
-
-            if ( base ) {
+        /* But first we check to see if there is a common prefix we can 
+           split out as an EXACT and put in front of the TRIE node.  */
+        trie->startstate= 1;
+        if ( trie->bitmap && !trie->widecharmap  ) {
+            U32 state;
+            DEBUG_OPTIMISE_r(
+                PerlIO_printf( Perl_debug_log,"%*sLaststate:%d\n", 
+                    (int)depth * 2 + 2,"",
+                    TRIE_LASTSTATE(trie)));
+            for( state= 1 ; state < TRIE_LASTSTATE(trie)-1 ; state++ ) {
                 U32 ofs = 0;
+                I32 idx= -1;
+                U32 count= 0;
+                const U32 base= trie->states[ state ].trans.base;
 
-                while( ( base + ofs  < trie->uniquecharcount ) ||
-                       ( base + ofs - trie->uniquecharcount < trie->lasttrans
-                         && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
-                        ofs++;
+                if ( trie->states[state].wordnum )
+                        count =1;
 
-                PerlIO_printf( Perl_debug_log, "+%02"UVXf"[ ", (UV)ofs);
+                for ( ofs= 0 ; ofs < trie->uniquecharcount ; ofs++ ) 
+                {
 
-                for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
                     if ( ( base + ofs >= trie->uniquecharcount ) &&
                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
                     {
-                       PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
-                        (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
-                    } else {
-                        PerlIO_printf( Perl_debug_log, "%4s ","   0" );
+                        if ( ++count > 1 ) {
+                            SV **tmp= av_fetch( TRIE_REVCHARMAP(trie), ofs, 0);
+                            const char *ch= SvPV_nolen_const( *tmp );
+                            if (state==1) break;
+                            if ( count == 2 ) {
+                                Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
+                                DEBUG_OPTIMISE_r(
+                                    PerlIO_printf( Perl_debug_log,"%*sNew Start State=%d Class: [", 
+                                        (int)depth * 2 + 2,"",
+                                        state));
+                                if (idx>-1) {
+                                    SV **tmp= av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
+                                    const char *ch= SvPV_nolen_const( *tmp );    
+                                
+                                    TRIE_BITMAP_SET(trie,*ch);
+                                    if ( folder ) 
+                                        TRIE_BITMAP_SET(trie,folder[ *ch ]); 
+                                    DEBUG_OPTIMISE_r(
+                                        PerlIO_printf( Perl_debug_log,"%s", ch)
+                                    );
                     }
                 }
-
-                PerlIO_printf( Perl_debug_log, "]");
-
+                            TRIE_BITMAP_SET(trie,*ch);
+                            if ( folder ) TRIE_BITMAP_SET(trie,folder[ *ch ]); 
+                            DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"%s", ch));
             }
-            PerlIO_printf( Perl_debug_log, "\n" );
+                        idx= ofs;
         }
-    });
-
-    {
-        /* 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 ( count == 1 ) {
+                    SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
+                    const char *ch= SvPV_nolen_const( *tmp );
+                    DEBUG_OPTIMISE_r(
+                        PerlIO_printf( Perl_debug_log,"%*sPrefix State: %d Idx:%d Char='%s'\n",
+                            (int)depth * 2 + 2,"",
+                            state,  idx, ch)
+                    );
+                    if ( state==1 ) {
+                        OP( convert ) = nodetype;
+                        str=STRING(convert);
+                        STR_LEN(convert)=0;
+                    }
+                    *str++=*ch;
+                    STR_LEN(convert)++;
 
-        if ( first == startbranch && OP( last ) != BRANCH ) {
-            convert = first;
         } else {
-            convert = NEXTOPER( first );
-            NEXT_OFF( first ) = (U16)(last - first);
+                    if (state>1)
+                        DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
+                    break;
         }
-
-        OP( convert ) = TRIE + (U8)( flags - EXACT );
+            }    
+            if (str) {
+                regnode *n= convert+NODE_SZ_STR(convert);
+                NEXT_OFF(convert)= NODE_SZ_STR(convert);
+                trie->startstate= state;
+                trie->minlen-= (state-1);
+                trie->maxlen-= (state-1);
+                if (trie->maxlen) 
+                    convert= n;
+                else {
+                    NEXT_OFF(convert) = (U16)(tail - convert);
+                }
+            }
+        }
+        if ( trie->maxlen ) {
+            OP( convert ) = TRIE;
         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 );
-
-
+            /* store the type in the flags */
+            convert->flags = nodetype;
+            /* XXX We really should free up the resource in trie now, as we wont use them */
+        }
         /* needed for dumping*/
         DEBUG_r({
             regnode *optimize = convert + NODE_STEP_REGNODE + regarglen[ TRIE ];
@@ -1475,8 +1672,6 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
     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.
@@ -1494,7 +1689,6 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 /* 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, U32 depth)
@@ -1515,33 +1709,43 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
 
     GET_RE_DEBUG_FLAGS_DECL;
 
+PEEP:
     while (scan && OP(scan) != END && scan < last) {
+        #ifdef DEBUGGING
+            int merged=0;
+        #endif
        /* Peephole optimizer: */
        DEBUG_OPTIMISE_r({
          SV * const mysv=sv_newmortal();
          regprop(RExC_rx, mysv, scan);
-         PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n",
-           (int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan));
+            PerlIO_printf(Perl_debug_log, "%*s%4s~ %s (%d)\n",
+                (int)depth*2, "",
+                scan==*scanp ? "Peep" : "",
+                SvPV_nolen_const(mysv), REG_NODE_NUM(scan));
        });
-
-       if (PL_regkind[(U8)OP(scan)] == EXACT) {
+       if (PL_regkind[OP(scan)] == EXACT) {
            /* Merge several consecutive EXACTish nodes into one. */
            regnode *n = regnext(scan);
            U32 stringok = 1;
 #ifdef DEBUGGING
            regnode *stop = scan;
 #endif
-
            next = scan + NODE_SZ_STR(scan);
            /* Skip NOTHING, merge EXACT*. */
            while (n &&
-                  ( PL_regkind[(U8)OP(n)] == NOTHING ||
+                  ( PL_regkind[OP(n)] == NOTHING ||
                     (stringok && (OP(n) == OP(scan))))
                   && NEXT_OFF(n)
                   && NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX) {
                if (OP(n) == TAIL || n > next)
                    stringok = 0;
-               if (PL_regkind[(U8)OP(n)] == NOTHING) {
+               if (PL_regkind[OP(n)] == NOTHING) {
+                    DEBUG_OPTIMISE_r({
+                        SV * const mysv=sv_newmortal();
+                        regprop(RExC_rx, mysv, n);
+                        PerlIO_printf(Perl_debug_log, "%*sskip: %s (%d)\n",
+                        (int)depth*2, "", SvPV_nolen_const(mysv), REG_NODE_NUM(n));
+                    });
                    NEXT_OFF(scan) += NEXT_OFF(n);
                    next = n + NODE_STEP_REGNODE;
 #ifdef DEBUGGING
@@ -1553,7 +1757,13 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                else if (stringok) {
                    const int oldl = STR_LEN(scan);
                    regnode * const nnext = regnext(n);
-
+                    DEBUG_OPTIMISE_r({
+                        SV * const mysv=sv_newmortal();
+                        regprop(RExC_rx, mysv, n);
+                        PerlIO_printf(Perl_debug_log, "%*s mrg: %s (%d)\n",
+                        (int)depth*2, "", SvPV_nolen_const(mysv), REG_NODE_NUM(n));
+                        merged++;
+                    });
                    if (oldl + STR_LEN(n) > U8_MAX)
                        break;
                    NEXT_OFF(scan) += NEXT_OFF(n);
@@ -1616,7 +1826,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
            /* Allow dumping */
            n = scan + NODE_SZ_STR(scan);
            while (n <= stop) {
-               if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) {
+               if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
                    OP(n) = OPTIMIZED;
                    NEXT_OFF(n) = 0;
                }
@@ -1640,7 +1850,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
        
            /* Skip NOTHING and LONGJMP. */
            while ((n = regnext(n))
-                  && ((PL_regkind[(U8)OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
+                  && ((PL_regkind[OP(n)] == NOTHING && (noff = NEXT_OFF(n)))
                       || ((OP(n) == LONGJMP) && (noff = ARG(n))))
                   && off + noff < max)
                off += noff;
@@ -1650,6 +1860,13 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                NEXT_OFF(scan) = off;
        }
 
+        DEBUG_OPTIMISE_r({if (merged){
+          SV * const mysv=sv_newmortal();
+          regprop(RExC_rx, mysv, scan);
+          PerlIO_printf(Perl_debug_log, "%*s res: %s (%d)\n",
+            (int)depth*2, "", SvPV_nolen_const(mysv), REG_NODE_NUM(scan));
+        }});
+
        /* The principal pseudo-switch.  Cannot be a switch, since we
           look into several different things.  */
        if (OP(scan) == BRANCH || OP(scan) == BRANCHJ
@@ -1704,10 +1921,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                    scan = next;
                    if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
                        pars++;
-                   if (data && (data_fake.flags & SF_HAS_EVAL))
+                   if (data) {
+                       if (data_fake.flags & SF_HAS_EVAL)
                        data->flags |= SF_HAS_EVAL;
-                   if (data)
                        data->whilem_c = data_fake.whilem_c;
+                   }
                    if (flags & SCF_DO_STCLASS)
                        cl_or(pRExC_state, &accum, &this_class);
                    if (code == SUSPEND)
@@ -1784,6 +2002,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
 
                */
                if (DO_TRIE) {
+                   int made=0;
                    if (!re_trie_maxbuff) {
                        re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1);
                        if (!SvIOK(re_trie_maxbuff))
@@ -1813,13 +2032,16 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                             tail = regnext( tail );
                         }
 
+                        
                         DEBUG_OPTIMISE_r({
                             regprop(RExC_rx, mysv, tail );
-                            PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
-                                (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen_const( mysv ),
-                                (RExC_seen_evals) ? "[EVAL]" : ""
+                            PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
+                                (int)depth * 2 + 2, "", 
+                                "Looking for TRIE'able sequences. Tail node is: ", 
+                                SvPV_nolen_const( mysv )
                             );
                         });
+                        
                         /*
 
                            step through the branches, cur represents each
@@ -1852,8 +2074,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
 
                             DEBUG_OPTIMISE_r({
                                 regprop(RExC_rx, mysv, cur);
-                                PerlIO_printf( Perl_debug_log, "%*s%s",
-                                   (int)depth * 2 + 2,"  ", SvPV_nolen_const( mysv ) );
+                                PerlIO_printf( Perl_debug_log, "%*s- %s (%d)",
+                                   (int)depth * 2 + 2,"", SvPV_nolen_const( mysv ), REG_NODE_NUM(cur) );
 
                                 regprop(RExC_rx, mysv, noper);
                                 PerlIO_printf( Perl_debug_log, " -> %s",
@@ -1864,47 +2086,26 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                                   PerlIO_printf( Perl_debug_log,"\t=> %s\t",
                                     SvPV_nolen_const(mysv));
                                 }
-                                PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n",
-                                   (void*)first, (void*)last, (void*)cur );
+                                PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d)\n",
+                                   REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur) );
                             });
-                            if ( ( first ? OP( noper ) == optype
-                                         : PL_regkind[ (U8)OP( noper ) ] == EXACT )
+                            if ( (((first && optype!=NOTHING) ? OP( noper ) == optype
+                                         : PL_regkind[ OP( noper ) ] == EXACT )
+                                  || OP(noper) == NOTHING )
                                   && noper_next == tail && count<U16_MAX)
                             {
                                 count++;
-                                if ( !first ) {
-                                    first = cur;
+                                if ( !first || optype == NOTHING ) {
+                                    if (!first) first = cur;
                                     optype = OP( noper );
                                 } else {
-                                    DEBUG_OPTIMISE_r(
-                                        if (!last ) {
-                                            regprop(RExC_rx, mysv, first);
-                                            PerlIO_printf( Perl_debug_log, "%*s%s",
-                                              (int)depth * 2 + 2, "F:", SvPV_nolen_const( mysv ) );
-                                            regprop(RExC_rx, mysv, NEXTOPER(first) );
-                                            PerlIO_printf( Perl_debug_log, " -> %s\n",
-                                              SvPV_nolen_const( mysv ) );
-                                        }
-                                    );
                                     last = cur;
-                                    DEBUG_OPTIMISE_r({
-                                        regprop(RExC_rx, mysv, cur);
-                                        PerlIO_printf( Perl_debug_log, "%*s%s",
-                                          (int)depth * 2 + 2, "N:", SvPV_nolen_const( mysv ) );
-                                        regprop(RExC_rx, mysv, noper );
-                                        PerlIO_printf( Perl_debug_log, " -> %s\n",
-                                          SvPV_nolen_const( mysv ) );
-                                    });
                                 }
                             } else {
                                 if ( last ) {
-                                    DEBUG_OPTIMISE_r(
-                                        PerlIO_printf( Perl_debug_log, "%*s%s\n",
-                                            (int)depth * 2 + 2, "E:", "**END**" );
-                                    );
-                                    make_trie( pRExC_state, startbranch, first, cur, tail, optype );
+                                    made+=make_trie( pRExC_state, startbranch, first, cur, tail, optype, depth+1 );
                                 }
-                                if ( PL_regkind[ (U8)OP( noper ) ] == EXACT
+                                if ( PL_regkind[ OP( noper ) ] == EXACT
                                      && noper_next == tail )
                                 {
                                     count = 1;
@@ -1921,19 +2122,21 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                         DEBUG_OPTIMISE_r({
                             regprop(RExC_rx, mysv, cur);
                             PerlIO_printf( Perl_debug_log,
-                              "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
-                              "  ", SvPV_nolen_const( mysv ), (void*)first, (void*)last, (void*)cur);
+                              "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
+                              "", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
 
                         });
                         if ( last ) {
-                            DEBUG_OPTIMISE_r(
-                                PerlIO_printf( Perl_debug_log, "%*s%s\n",
-                                    (int)depth * 2 + 2, "E:", "==END==" );
-                            );
-                            make_trie( pRExC_state, startbranch, first, scan, tail, optype );
+                            made+= make_trie( pRExC_state, startbranch, first, scan, tail, optype, depth+1 );
+#ifdef TRIE_STUDY_OPT  
+                            if ( OP(first)!=TRIE  && startbranch == first ) {
+                                
                         }
+#endif
                     }
                 }
+                    
+                } /* do trie */
            }
            else if ( code == BRANCHJ ) {  /* single branch is optimized. */
                scan = NEXTOPER(NEXTOPER(scan));
@@ -2005,7 +2208,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
            }
            flags &= ~SCF_DO_STCLASS;
        }
-       else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */
+       else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT! */
            I32 l = STR_LEN(scan);
            UV uc = *((U8*)STRING(scan));
 
@@ -2053,6 +2256,18 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
            }
            flags &= ~SCF_DO_STCLASS;
        }
+#ifdef TRIE_STUDY_OPT  
+       else if (OP(scan) == TRIE) {
+           reg_trie_data *trie=RExC_rx->data->data[ ARG(scan) ];
+           min += trie->minlen;
+           flags &= ~SCF_DO_STCLASS; /* xxx */
+            if (flags & SCF_DO_SUBSTR) {
+               scan_commit(pRExC_state,data);  /* Cannot expect anything... */
+               data->pos_min += trie->minlen;
+               data->pos_delta+= (trie->maxlen-trie->minlen);
+           }
+       }
+#endif 
        else if (strchr((const char*)PL_varies,OP(scan))) {
            I32 mincount, maxcount, minnext, deltanext, fl = 0;
            I32 f = flags, pos_before = 0;
@@ -2061,7 +2276,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
            struct regnode_charclass_class *oclass = NULL;
            I32 next_is_eval = 0;
 
-           switch (PL_regkind[(U8)OP(scan)]) {
+           switch (PL_regkind[OP(scan)]) {
            case WHILEM:                /* End of (?:...)* . */
                scan = NEXTOPER(scan);
                goto finish;
@@ -2198,7 +2413,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                    /* Skip open. */
                    nxt = regnext(nxt);
                    if (!strchr((const char*)PL_simple,OP(nxt))
-                       && !(PL_regkind[(U8)OP(nxt)] == EXACT
+                       && !(PL_regkind[OP(nxt)] == EXACT
                             && STR_LEN(nxt) == 1))
                        goto nogo;
 #ifdef DEBUGGING
@@ -2391,7 +2606,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                    data->flags |= SF_HAS_EVAL;
              optimize_curly_tail:
                if (OP(oscan) != CURLYX) {
-                   while (PL_regkind[(U8)OP(next = regnext(oscan))] == NOTHING
+                   while (PL_regkind[OP(next = regnext(oscan))] == NOTHING
                           && NEXT_OFF(next))
                        NEXT_OFF(oscan) += NEXT_OFF(next);
                }
@@ -2421,7 +2636,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
 
                /* Some of the logic below assumes that switching
                   locale on will only add false positives. */
-               switch (PL_regkind[(U8)OP(scan)]) {
+               switch (PL_regkind[OP(scan)]) {
                case SANY:
                default:
                  do_default:
@@ -2608,12 +2823,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
                flags &= ~SCF_DO_STCLASS;
            }
        }
-       else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
+       else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) {
            data->flags |= (OP(scan) == MEOL
                            ? SF_BEFORE_MEOL
                            : SF_BEFORE_SEOL);
        }
-       else if (  PL_regkind[(U8)OP(scan)] == BRANCHJ
+       else if (  PL_regkind[OP(scan)] == BRANCHJ
                 /* Lookbehind, or need to calculate parens/evals/stclass: */
                   && (scan->flags || data || (flags & SCF_DO_STCLASS))
                   && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
@@ -2828,11 +3043,14 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        * Clever compilers notice this and complain. --jhi */
     REGC((U8)REG_MAGIC, (char*)RExC_emit);
 #endif
-    if (reg(pRExC_state, 0, &flags) == NULL) {
+    DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Starting first pass (sizing)\n"));
+    if (reg(pRExC_state, 0, &flags,1) == NULL) {
        RExC_precomp = NULL;
        return(NULL);
     }
-    DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)RExC_size));
+    DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "Required "));
+    DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" nodes ", (IV)RExC_size));
+    DEBUG_PARSE_r(PerlIO_printf(Perl_debug_log, "\nStarting second pass (creation)\n"));
 
     /* Small enough for pointer-storage convention?
        If extralen==0, this means that we will not need long jumps. */
@@ -2891,7 +3109,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     RExC_emit->next_off = (U16)((RExC_seen_evals > U16_MAX) ? U16_MAX : RExC_seen_evals);
     REGC((U8)REG_MAGIC, (char*) RExC_emit++);
     r->data = 0;
-    if (reg(pRExC_state, 0, &flags) == NULL)
+    if (reg(pRExC_state, 0, &flags,1) == NULL)
        return(NULL);
 
 
@@ -2926,17 +3144,17 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            (OP(first) == PLUS) ||
            (OP(first) == MINMOD) ||
               /* An {n,m} with n>0 */
-           (PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
+           (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ) {
                if (OP(first) == PLUS)
                    sawplus = 1;
                else
-                   first += regarglen[(U8)OP(first)];
+                   first += regarglen[OP(first)];
                first = NEXTOPER(first);
        }
 
        /* Starting-point info. */
       again:
-       if (PL_regkind[(U8)OP(first)] == EXACT) {
+       if (PL_regkind[OP(first)] == EXACT) {
            if (OP(first) == EXACT)
                NOOP;   /* Empty, get anchored substr later. */
            else if ((OP(first) == EXACTF || OP(first) == EXACTFL))
@@ -2944,10 +3162,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        }
        else if (strchr((const char*)PL_simple,OP(first)))
            r->regstclass = first;
-       else if (PL_regkind[(U8)OP(first)] == BOUND ||
-                PL_regkind[(U8)OP(first)] == NBOUND)
+       else if (PL_regkind[OP(first)] == BOUND ||
+                PL_regkind[OP(first)] == NBOUND)
            r->regstclass = first;
-       else if (PL_regkind[(U8)OP(first)] == BOL) {
+       else if (PL_regkind[OP(first)] == BOL) {
            r->reganch |= (OP(first) == MBOL
                           ? ROPT_ANCH_MBOL
                           : (OP(first) == SBOL
@@ -2962,7 +3180,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            goto again;
        }
        else if (!sawopen && (OP(first) == STAR &&
-           PL_regkind[(U8)OP(NEXTOPER(first))] == REG_ANY) &&
+           PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
            !(r->reganch & ROPT_ANCH) )
        {
            /* turn .* into ^.* with an implied $*=1 */
@@ -3167,10 +3385,54 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
        r->reganch |= ROPT_CANY_SEEN;
     Newxz(r->startp, RExC_npar, I32);
     Newxz(r->endp, RExC_npar, I32);
-    DEBUG_COMPILE_r(regdump(r));
+    DEBUG_COMPILE_r({
+        if (SvIV(re_debug_flags)> (RE_DEBUG_COMPILE | RE_DEBUG_EXECUTE)) 
+            PerlIO_printf(Perl_debug_log,"Final program:\n");
+        regdump(r);
+    });
     return(r);
 }
 
+
+#define DEBUG_PARSE_MSG(funcname)     DEBUG_PARSE_r({           \
+    int rem=(int)(RExC_end - RExC_parse);                       \
+    int cut;                                                    \
+    int num;                                                    \
+    int iscut=0;                                                \
+    if (rem>10) {                                               \
+        rem=10;                                                 \
+        iscut=1;                                                \
+    }                                                           \
+    cut=10-rem;                                                 \
+    if (RExC_lastparse!=RExC_parse)                             \
+        PerlIO_printf(Perl_debug_log," >%.*s%-*s",              \
+            rem, RExC_parse,                                    \
+            cut + 4,                                            \
+            iscut ? "..." : "<"                                 \
+        );                                                      \
+    else                                                        \
+        PerlIO_printf(Perl_debug_log,"%16s","");                \
+                                                                \
+    if (SIZE_ONLY)                                              \
+       num=RExC_size;                                           \
+    else                                                        \
+       num=REG_NODE_NUM(RExC_emit);                             \
+    if (RExC_lastnum!=num)                                      \
+       PerlIO_printf(Perl_debug_log,"%4d",num);                 \
+    else                                                        \
+       PerlIO_printf(Perl_debug_log,"%4s","");                  \
+    PerlIO_printf(Perl_debug_log,"%*s%-4s",                     \
+        10+(depth*2),"",                                        \
+        (funcname)                                              \
+    );                                                          \
+    RExC_lastnum=num;                                           \
+    RExC_lastparse=RExC_parse;                                  \
+})
+
+#define DEBUG_PARSE(funcname)     DEBUG_PARSE_r({           \
+    DEBUG_PARSE_MSG((funcname));                            \
+    PerlIO_printf(Perl_debug_log,"%4s","\n");               \
+})
 /*
  - reg - regular expression, i.e. main body or parenthesized thing
  *
@@ -3180,8 +3442,10 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
  * is a trifle forced, but the need to tie the tails of the branches to what
  * follows makes it hard to avoid.
  */
+#define REGTAIL(x,y,z) regtail(x,y,z,depth+1)
+
 STATIC regnode *
-S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
+S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
 {
     dVAR;
@@ -3207,6 +3471,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     char * parse_start = RExC_parse; /* MJD */
     char * const oregcomp_parse = RExC_parse;
 
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_PARSE("reg ");
+
+
     *flagp = 0;                                /* Tentatively. */
 
 
@@ -3318,7 +3586,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    ret = reg_node(pRExC_state, LOGICAL);
                    if (!SIZE_ONLY)
                        ret->flags = 2;
-                   regtail(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
+                    REGTAIL(pRExC_state, ret, reganode(pRExC_state, EVAL, n));
                     /* deal with the length of this later - MJD */
                    return ret;
                }
@@ -3338,7 +3606,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                        ret = reg_node(pRExC_state, LOGICAL);
                        if (!SIZE_ONLY)
                            ret->flags = 1;
-                       regtail(pRExC_state, ret, reg(pRExC_state, 1, &flag));
+                        REGTAIL(pRExC_state, ret, reg(pRExC_state, 1, &flag,depth+1));
                        goto insert_if;
                    }
                }
@@ -3354,19 +3622,19 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    if ((c = *nextchar(pRExC_state)) != ')')
                        vFAIL("Switch condition not recognized");
                  insert_if:
-                   regtail(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
-                   br = regbranch(pRExC_state, &flags, 1);
+                    REGTAIL(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0));
+                    br = regbranch(pRExC_state, &flags, 1,depth+1);
                    if (br == NULL)
                        br = reganode(pRExC_state, LONGJMP, 0);
                    else
-                       regtail(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
+                        REGTAIL(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
                    c = *nextchar(pRExC_state);
                    if (flags&HASWIDTH)
                        *flagp |= HASWIDTH;
                    if (c == '|') {
                        lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
-                       regbranch(pRExC_state, &flags, 1);
-                       regtail(pRExC_state, ret, lastbr);
+                        regbranch(pRExC_state, &flags, 1,depth+1);
+                        REGTAIL(pRExC_state, ret, lastbr);
                        if (flags&HASWIDTH)
                            *flagp |= HASWIDTH;
                        c = *nextchar(pRExC_state);
@@ -3376,13 +3644,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    if (c != ')')
                        vFAIL("Switch (?(condition)... contains too many branches");
                    ender = reg_node(pRExC_state, TAIL);
-                   regtail(pRExC_state, br, ender);
+                    REGTAIL(pRExC_state, br, ender);
                    if (lastbr) {
-                       regtail(pRExC_state, lastbr, ender);
-                       regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
+                        REGTAIL(pRExC_state, lastbr, ender);
+                        REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
                    }
                    else
-                       regtail(pRExC_state, ret, ender);
+                        REGTAIL(pRExC_state, ret, ender);
                    return ret;
                }
                else {
@@ -3470,7 +3738,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
 
     /* Pick up the branches, linking them together. */
     parse_start = RExC_parse;   /* MJD */
-    br = regbranch(pRExC_state, &flags, 1);
+    br = regbranch(pRExC_state, &flags, 1,depth+1);
     /*     branch_len = (paren != 0); */
 
     if (br == NULL)
@@ -3492,7 +3760,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
        *flagp |= flags&SIMPLE;
     }
     if (is_open) {                             /* Starts with OPEN. */
-       regtail(pRExC_state, ret, br);          /* OPEN -> first. */
+        REGTAIL(pRExC_state, ret, br);          /* OPEN -> first. */
     }
     else if (paren != '?')             /* Not Conditional */
        ret = br;
@@ -3501,16 +3769,16 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     while (*RExC_parse == '|') {
        if (!SIZE_ONLY && RExC_extralen) {
            ender = reganode(pRExC_state, LONGJMP,0);
-           regtail(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
+            REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
        }
        if (SIZE_ONLY)
            RExC_extralen += 2;         /* Account for LONGJMP. */
        nextchar(pRExC_state);
-       br = regbranch(pRExC_state, &flags, 0);
+        br = regbranch(pRExC_state, &flags, 0, depth+1);
 
        if (br == NULL)
            return(NULL);
-       regtail(pRExC_state, lastbr, br);               /* BRANCH -> BRANCH. */
+        REGTAIL(pRExC_state, lastbr, br);               /* BRANCH -> BRANCH. */
        lastbr = br;
        if (flags&HASWIDTH)
            *flagp |= HASWIDTH;
@@ -3541,18 +3809,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
            ender = reg_node(pRExC_state, END);
            break;
        }
-       regtail(pRExC_state, lastbr, ender);
+        REGTAIL(pRExC_state, lastbr, ender);
 
        if (have_branch && !SIZE_ONLY) {
            /* Hook the tails of the branches to the closing node. */
+            U8 exact= PSEUDO;
            for (br = ret; br; br = regnext(br)) {
                const U8 op = PL_regkind[OP(br)];
+                U8 exact_ret;
                if (op == BRANCH) {
-                   regtail(pRExC_state, NEXTOPER(br), ender);
+                    exact_ret=regtail_study(pRExC_state, NEXTOPER(br), ender,depth+1);
                }
                else if (op == BRANCHJ) {
-                   regtail(pRExC_state, NEXTOPER(NEXTOPER(br)), ender);
+                    exact_ret=regtail_study(pRExC_state, NEXTOPER(NEXTOPER(br)), ender,depth+1);
                }
+                if ( exact == PSEUDO )
+                    exact= exact_ret;
+                else if ( exact != exact_ret )
+                    exact= 0;
            }
        }
     }
@@ -3571,7 +3845,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
            Set_Node_Cur_Length(ret);
            Set_Node_Offset(ret, parse_start + 1);
            ret->flags = flag;
-           regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
+            REGTAIL(pRExC_state, ret, reg_node(pRExC_state, TAIL));
        }
     }
 
@@ -3602,14 +3876,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
  * Implements the concatenation operator.
  */
 STATIC regnode *
-S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
+S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth)
 {
     dVAR;
     register regnode *ret;
     register regnode *chain = NULL;
     register regnode *latest;
     I32 flags = 0, c = 0;
-
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_PARSE("brnc");
     if (first)
        ret = NULL;
     else {
@@ -3630,7 +3905,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
     nextchar(pRExC_state);
     while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') {
        flags &= ~TRYAGAIN;
-       latest = regpiece(pRExC_state, &flags);
+        latest = regpiece(pRExC_state, &flags,depth+1);
        if (latest == NULL) {
            if (flags & TRYAGAIN)
                continue;
@@ -3643,7 +3918,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
            *flagp |= flags&SPSTART;
        else {
            RExC_naughty++;
-           regtail(pRExC_state, chain, latest);
+            REGTAIL(pRExC_state, chain, latest);
        }
        chain = latest;
        c++;
@@ -3670,7 +3945,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first)
  * endmarker role is not redundant.
  */
 STATIC regnode *
-S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
+S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
 {
     dVAR;
     register regnode *ret;
@@ -3682,8 +3957,10 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
     I32 min;
     I32 max = REG_INFTY;
     char *parse_start;
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_PARSE("piec");
 
-    ret = regatom(pRExC_state, &flags);
+    ret = regatom(pRExC_state, &flags,depth+1);
     if (ret == NULL) {
        if (flags & TRYAGAIN)
            *flagp |= TRYAGAIN;
@@ -3693,9 +3970,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
     op = *RExC_parse;
 
     if (op == '{' && regcurly(RExC_parse)) {
+       const char *maxpos = NULL;
         parse_start = RExC_parse; /* MJD */
        next = RExC_parse + 1;
-       maxpos = NULL;
        while (isDIGIT(*next) || *next == ',') {
            if (*next == ',') {
                if (maxpos)
@@ -3730,10 +4007,10 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
                 Set_Node_Cur_Length(ret);
            }
            else {
-               regnode *w = reg_node(pRExC_state, WHILEM);
+               regnode * const w = reg_node(pRExC_state, WHILEM);
 
                w->flags = 0;
-               regtail(pRExC_state, ret, w);
+                REGTAIL(pRExC_state, ret, w);
                if (!SIZE_ONLY && RExC_extralen) {
                    reginsert(pRExC_state, LONGJMP,ret);
                    reginsert(pRExC_state, NOTHING,ret);
@@ -3747,7 +4024,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
 
                if (!SIZE_ONLY && RExC_extralen)
                    NEXT_OFF(ret) = 3;  /* Go over NOTHING to LONGJMP. */
-               regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
+                REGTAIL(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
                if (SIZE_ONLY)
                    RExC_whilem_seen++, RExC_extralen += 3;
                RExC_naughty += 4 + RExC_naughty;       /* compound interest */
@@ -3828,7 +4105,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
     if (*RExC_parse == '?') {
        nextchar(pRExC_state);
        reginsert(pRExC_state, MINMOD, ret);
-       regtail(pRExC_state, ret, ret + NODE_STEP_REGNODE);
+        REGTAIL(pRExC_state, ret, ret + NODE_STEP_REGNODE);
     }
     if (ISMULT2(RExC_parse)) {
        RExC_parse++;
@@ -3850,13 +4127,14 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
  * [It looks like its ok, as in S_study_chunk we merge adjacent EXACT nodes]
  */
 STATIC regnode *
-S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
+S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
 {
     dVAR;
     register regnode *ret = NULL;
     I32 flags;
     char *parse_start = RExC_parse;
-
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_PARSE("atom");
     *flagp = WORST;            /* Tentatively. */
 
 tryagain:
@@ -3896,8 +4174,8 @@ tryagain:
        break;
     case '[':
     {
-       char *oregcomp_parse = ++RExC_parse;
-       ret = regclass(pRExC_state);
+       char * const oregcomp_parse = ++RExC_parse;
+        ret = regclass(pRExC_state,depth+1);
        if (*RExC_parse != ']') {
            RExC_parse = oregcomp_parse;
            vFAIL("Unmatched [");
@@ -3909,7 +4187,7 @@ tryagain:
     }
     case '(':
        nextchar(pRExC_state);
-       ret = reg(pRExC_state, 1, &flags);
+        ret = reg(pRExC_state, 1, &flags,depth+1);
        if (ret == NULL) {
                if (flags & TRYAGAIN) {
                    if (RExC_parse == RExC_end) {
@@ -4041,14 +4319,14 @@ tryagain:
        case 'p':
        case 'P':
            {   
-               char* oldregxend = RExC_end;
+               char* const oldregxend = RExC_end;
                char* parse_start = RExC_parse - 2;
 
                if (RExC_parse[1] == '{') {
                  /* a lovely hack--pretend we saw [\pX] instead */
                    RExC_end = strchr(RExC_parse, '}');
                    if (!RExC_end) {
-                       U8 c = (U8)*RExC_parse;
+                       const U8 c = (U8)*RExC_parse;
                        RExC_parse += 2;
                        RExC_end = oldregxend;
                        vFAIL2("Missing right brace on \\%c{}", c);
@@ -4062,7 +4340,7 @@ tryagain:
                }
                RExC_parse--;
 
-               ret = regclass(pRExC_state);
+                ret = regclass(pRExC_state,depth+1);
 
                RExC_end = oldregxend;
                RExC_parse--;
@@ -4091,7 +4369,7 @@ tryagain:
                if (num > 9 && num >= RExC_npar)
                    goto defchar;
                else {
-                    char * parse_start = RExC_parse - 1; /* MJD */
+                   char * const parse_start = RExC_parse - 1; /* MJD */
                    while (isDIGIT(*RExC_parse))
                        RExC_parse++;
 
@@ -4125,7 +4403,8 @@ tryagain:
 
     case '#':
        if (RExC_flags & PMf_EXTENDED) {
-           while (RExC_parse < RExC_end && *RExC_parse != '\n') RExC_parse++;
+           while (RExC_parse < RExC_end && *RExC_parse != '\n')
+               RExC_parse++;
            if (RExC_parse < RExC_end)
                goto tryagain;
        }
@@ -4135,7 +4414,7 @@ tryagain:
            register STRLEN len;
            register UV ender;
            register char *p;
-           char *oldp, *s;
+           char *s;
            STRLEN foldlen;
            U8 tmpbuf[UTF8_MAXBYTES_CASE+1], *foldbuf;
 
@@ -4152,7 +4431,7 @@ tryagain:
              len < 127 && p < RExC_end;
              len++)
            {
-               oldp = p;
+               char * const oldp = p;
 
                if (RExC_flags & PMf_EXTENDED)
                    p = regwhite(p, RExC_end);
@@ -4368,21 +4647,22 @@ tryagain:
                *flagp |= HASWIDTH;
            if (len == 1 && UNI_IS_INVARIANT(ender))
                *flagp |= SIMPLE;
-           if (!SIZE_ONLY)
-               STR_LEN(ret) = len;
+               
            if (SIZE_ONLY)
                RExC_size += STR_SZ(len);
-           else
+           else {
+               STR_LEN(ret) = len;
                RExC_emit += STR_SZ(len);
        }
+       }
        break;
     }
 
     /* If the encoding pragma is in effect recode the text of
      * any EXACT-kind nodes. */
-    if (PL_encoding && PL_regkind[(U8)OP(ret)] == EXACT) {
-       STRLEN oldlen = STR_LEN(ret);
-       SV *sv        = sv_2mortal(newSVpvn(STRING(ret), oldlen));
+    if (PL_encoding && PL_regkind[OP(ret)] == EXACT) {
+       const STRLEN oldlen = STR_LEN(ret);
+       SV * const sv = sv_2mortal(newSVpvn(STRING(ret), oldlen));
 
        if (RExC_utf8)
            SvUTF8_on(sv);
@@ -4453,14 +4733,13 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
            /* Grandfather lone [:, [=, [. */
            RExC_parse = s;
        else {
-           const char* t = RExC_parse++; /* skip over the c */
-           const char *posixcc;
-
+           const char* const t = RExC_parse++; /* skip over the c */
            assert(*t == c);
 
            if (UCHARAT(RExC_parse) == ']') {
+               const char *posixcc = s + 1;
                RExC_parse++; /* skip over the ending ] */
-               posixcc = s + 1;
+
                if (*s == ':') {
                    const I32 complement = *posixcc == '^' ? *posixcc++ : 0;
                    const I32 skip = t - posixcc;
@@ -4468,11 +4747,8 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
                    /* Initially switch on the length of the name.  */
                    switch (skip) {
                    case 4:
-                       if (memEQ(posixcc, "word", 4)) {
-                           /* this is not POSIX, this is the Perl \w */;
-                           namedclass
-                               = complement ? ANYOF_NALNUM : ANYOF_ALNUM;
-                       }
+                       if (memEQ(posixcc, "word", 4)) /* this is not POSIX, this is the Perl \w */
+                           namedclass = complement ? ANYOF_NALNUM : ANYOF_ALNUM;
                        break;
                    case 5:
                        /* Names all of length 5.  */
@@ -4481,98 +4757,58 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value)
                        /* Offset 4 gives the best switch position.  */
                        switch (posixcc[4]) {
                        case 'a':
-                           if (memEQ(posixcc, "alph", 4)) {
-                               /*                  a     */
-                               namedclass
-                                   = complement ? ANYOF_NALPHA : ANYOF_ALPHA;
-                           }
+                           if (memEQ(posixcc, "alph", 4)) /* alpha */
+                               namedclass = complement ? ANYOF_NALPHA : ANYOF_ALPHA;
                            break;
                        case 'e':
-                           if (memEQ(posixcc, "spac", 4)) {
-                               /*                  e     */
-                               namedclass
-                                   = complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
-                           }
+                           if (memEQ(posixcc, "spac", 4)) /* space */
+                               namedclass = complement ? ANYOF_NPSXSPC : ANYOF_PSXSPC;
                            break;
                        case 'h':
-                           if (memEQ(posixcc, "grap", 4)) {
-                               /*                  h     */
-                               namedclass
-                                   = complement ? ANYOF_NGRAPH : ANYOF_GRAPH;
-                           }
+                           if (memEQ(posixcc, "grap", 4)) /* graph */
+                               namedclass = complement ? ANYOF_NGRAPH : ANYOF_GRAPH;
                            break;
                        case 'i':
-                           if (memEQ(posixcc, "asci", 4)) {
-                               /*                  i     */
-                               namedclass
-                                   = complement ? ANYOF_NASCII : ANYOF_ASCII;
-                           }
+                           if (memEQ(posixcc, "asci", 4)) /* ascii */
+                               namedclass = complement ? ANYOF_NASCII : ANYOF_ASCII;
                            break;
                        case 'k':
-                           if (memEQ(posixcc, "blan", 4)) {
-                               /*                  k     */
-                               namedclass
-                                   = complement ? ANYOF_NBLANK : ANYOF_BLANK;
-                           }
+                           if (memEQ(posixcc, "blan", 4)) /* blank */
+                               namedclass = complement ? ANYOF_NBLANK : ANYOF_BLANK;
                            break;
                        case 'l':
-                           if (memEQ(posixcc, "cntr", 4)) {
-                               /*                  l     */
-                               namedclass
-                                   = complement ? ANYOF_NCNTRL : ANYOF_CNTRL;
-                           }
+                           if (memEQ(posixcc, "cntr", 4)) /* cntrl */
+                               namedclass = complement ? ANYOF_NCNTRL : ANYOF_CNTRL;
                            break;
                        case 'm':
-                           if (memEQ(posixcc, "alnu", 4)) {
-                               /*                  m     */
-                               namedclass
-                                   = complement ? ANYOF_NALNUMC : ANYOF_ALNUMC;
-                           }
+                           if (memEQ(posixcc, "alnu", 4)) /* alnum */
+                               namedclass = complement ? ANYOF_NALNUMC : ANYOF_ALNUMC;
                            break;
                        case 'r':
-                           if (memEQ(posixcc, "lowe", 4)) {
-                               /*                  r     */
-                               namedclass
-                                   = complement ? ANYOF_NLOWER : ANYOF_LOWER;
-                           }
-                           if (memEQ(posixcc, "uppe", 4)) {
-                               /*                  r     */
-                               namedclass
-                                   = complement ? ANYOF_NUPPER : ANYOF_UPPER;
-                           }
+                           if (memEQ(posixcc, "lowe", 4)) /* lower */
+                               namedclass = complement ? ANYOF_NLOWER : ANYOF_LOWER;
+                           else if (memEQ(posixcc, "uppe", 4)) /* upper */
+                               namedclass = complement ? ANYOF_NUPPER : ANYOF_UPPER;
                            break;
                        case 't':
-                           if (memEQ(posixcc, "digi", 4)) {
-                               /*                  t     */
-                               namedclass
-                                   = complement ? ANYOF_NDIGIT : ANYOF_DIGIT;
-                           }
-                           if (memEQ(posixcc, "prin", 4)) {
-                               /*                  t     */
-                               namedclass
-                                   = complement ? ANYOF_NPRINT : ANYOF_PRINT;
-                           }
-                           if (memEQ(posixcc, "punc", 4)) {
-                               /*                  t     */
-                               namedclass
-                                   = complement ? ANYOF_NPUNCT : ANYOF_PUNCT;
-                           }
+                           if (memEQ(posixcc, "digi", 4)) /* digit */
+                               namedclass = complement ? ANYOF_NDIGIT : ANYOF_DIGIT;
+                           else if (memEQ(posixcc, "prin", 4)) /* print */
+                               namedclass = complement ? ANYOF_NPRINT : ANYOF_PRINT;
+                           else if (memEQ(posixcc, "punc", 4)) /* punct */
+                               namedclass = complement ? ANYOF_NPUNCT : ANYOF_PUNCT;
                            break;
                        }
                        break;
                    case 6:
-                       if (memEQ(posixcc, "xdigit", 6)) {
-                           namedclass
-                               = complement ? ANYOF_NXDIGIT : ANYOF_XDIGIT;
-                       }
+                       if (memEQ(posixcc, "xdigit", 6))
+                           namedclass = complement ? ANYOF_NXDIGIT : ANYOF_XDIGIT;
                        break;
                    }
 
                    if (namedclass == OOB_NAMEDCLASS)
-                   {
                        Simple_vFAIL3("POSIX class [:%.*s:] unknown",
                                      t - s - 1, s + 1);
-                   }
                    assert (posixcc[skip] == ':');
                    assert (posixcc[skip+1] == ']');
                } else if (!SIZE_ONLY) {
@@ -4599,11 +4835,11 @@ STATIC void
 S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
 {
     dVAR;
-    if (!SIZE_ONLY && POSIXCC(UCHARAT(RExC_parse))) {
+    if (POSIXCC(UCHARAT(RExC_parse))) {
        const char *s = RExC_parse;
        const char  c = *s++;
 
-       while(*s && isALNUM(*s))
+       while (isALNUM(*s))
            s++;
        if (*s && c == *s && s[1] == ']') {
            if (ckWARN(WARN_REGEXP))
@@ -4616,7 +4852,7 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
                /* adjust RExC_parse so the error shows after
                   the class closes */
                while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']')
-                   ;
+                   NOOP;
                Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c);
            }
        }
@@ -4630,7 +4866,7 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state)
    that char is < 256 then we produce an EXACT node instead.
 */
 STATIC regnode *
-S_regclass(pTHX_ RExC_state_t *pRExC_state)
+S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth)
 {
     dVAR;
     register UV value;
@@ -4643,7 +4879,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
     char *rangebegin = NULL;
     bool need_class = 0;
     SV *listsv = NULL;
-    register char *e;
     UV n;
     bool optimize_invert   = TRUE;
     AV* unicode_alternate  = NULL;
@@ -4652,8 +4887,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
 #endif
     UV stored = 0;  /* number of chars stored in the class */
 
-    regnode *orig_emit = RExC_emit; /* Save the original RExC_emit in
+    regnode * const orig_emit = RExC_emit; /* Save the original RExC_emit in
         case we need to change the emitted regop to an EXACT. */
+    GET_RE_DEBUG_FLAGS_DECL;
+    DEBUG_PARSE("clas");
 
     /* Assume we are going to generate an ANYOF node. */
     ret = reganode(pRExC_state, ANYOF, 0);
@@ -4734,6 +4971,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
            case 'D':   namedclass = ANYOF_NDIGIT;      break;
            case 'p':
            case 'P':
+               {
+               char *e;
                if (RExC_parse >= RExC_end)
                    vFAIL2("Empty \\%c{}", (U8)value);
                if (*RExC_parse == '{') {
@@ -4769,6 +5008,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                RExC_parse = e + 1;
                ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
                namedclass = ANYOF_MAX;  /* no official name, but it's named */
+               }
                break;
            case 'n':   value = '\n';                   break;
            case 'r':   value = '\r';                   break;
@@ -4781,7 +5021,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
                if (*RExC_parse == '{') {
                     I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
                         | PERL_SCAN_DISALLOW_PREFIX;
-                   e = strchr(RExC_parse++, '}');
+                   char * const e = strchr(RExC_parse++, '}');
                     if (!e)
                         vFAIL("Missing right brace on \\x{}");
 
@@ -5260,10 +5500,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
        /* now is the next time */
         stored += (value - prevvalue + 1);
        if (!SIZE_ONLY) {
-           IV i;
            if (prevvalue < 256) {
                const IV ceilvalue = value < 256 ? value : 255;
-
+               IV i;
 #ifdef EBCDIC
                /* In EBCDIC [\x89-\x91] should include
                 * the \x8e but [i-j] should not. */
@@ -5472,7 +5711,6 @@ S_reg_node(pTHX_ RExC_state_t *pRExC_state, U8 op)
        RExC_size += 1;
        return(ret);
     }
-
     NODE_ALIGN_FILL(ret);
     ptr = ret;
     FILL_ADVANCE_NODE(ptr, op);
@@ -5603,13 +5841,15 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd)
 
 /*
 - regtail - set the next-pointer at the end of a node chain of p to val.
+- SEE ALSO: regtail_study
 */
 /* TODO: All three parms should be const */
 STATIC void
-S_regtail(pTHX_ const RExC_state_t *pRExC_state, regnode *p, const regnode *val)
+S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
 {
     dVAR;
     register regnode *scan;
+    GET_RE_DEBUG_FLAGS_DECL;
 
     if (SIZE_ONLY)
        return;
@@ -5618,6 +5858,72 @@ S_regtail(pTHX_ const RExC_state_t *pRExC_state, regnode *p, const regnode *val)
     scan = p;
     for (;;) {
        regnode * const temp = regnext(scan);
+        DEBUG_PARSE_r({
+            SV * const mysv=sv_newmortal();
+            DEBUG_PARSE_MSG((scan==p ? "tail" : ""));
+            regprop(RExC_rx, mysv, scan);
+            PerlIO_printf(Perl_debug_log, "~ %s (%d)\n",
+                SvPV_nolen_const(mysv), REG_NODE_NUM(scan));
+        });
+        if (temp == NULL)
+            break;
+        scan = temp;
+    }
+
+    if (reg_off_by_arg[OP(scan)]) {
+        ARG_SET(scan, val - scan);
+    }
+    else {
+        NEXT_OFF(scan) = val - scan;
+    }
+}
+
+/*
+- regtail_study - set the next-pointer at the end of a node chain of p to val.
+- Look for optimizable sequences at the same time.
+- currently only looks for EXACT chains.
+*/
+/* TODO: All four parms should be const */
+STATIC U8
+S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
+{
+    dVAR;
+    register regnode *scan;
+    U8 exact= PSEUDO;
+    GET_RE_DEBUG_FLAGS_DECL;
+
+    if (SIZE_ONLY)
+        return exact;
+
+    /* Find last node. */
+
+    scan = p;
+    for (;;) {
+        regnode * const temp = regnext(scan);
+        if ( exact ) {
+            switch (OP(scan)) {
+                case EXACT:
+                case EXACTF:
+                case EXACTFL:
+                        if( exact == PSEUDO )
+                            exact= OP(scan);
+                    else if ( exact != OP(scan) )
+                        exact= 0;
+                case NOTHING:
+                    break;
+                default:
+                    exact= 0;
+            }
+        }
+        DEBUG_PARSE_r({
+            SV * const mysv=sv_newmortal();
+            DEBUG_PARSE_MSG((scan==p ? "tsdy" : ""));
+            regprop(RExC_rx, mysv, scan);
+            PerlIO_printf(Perl_debug_log, "~ %s (%s) (%d)\n",
+                SvPV_nolen_const(mysv),
+                reg_name[exact],
+                REG_NODE_NUM(scan));
+        });
        if (temp == NULL)
            break;
        scan = temp;
@@ -5629,6 +5935,8 @@ S_regtail(pTHX_ const RExC_state_t *pRExC_state, regnode *p, const regnode *val)
     else {
        NEXT_OFF(scan) = val - scan;
     }
+
+    return exact;
 }
 
 /*
@@ -5775,7 +6083,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
        Perl_croak(aTHX_ "Corrupted regexp opcode");
     sv_catpv(sv, reg_name[OP(o)]); /* Take off const! */
 
-    k = PL_regkind[(U8)OP(o)];
+    k = PL_regkind[OP(o)];
 
     if (k == EXACT) {
        SV * const dsv = sv_2mortal(newSVpvs(""));
@@ -5795,8 +6103,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
                       len, s,
                       PL_colors[1]);
     } else if (k == TRIE) {
-       NOOP;
-       /* print the details od the trie in dumpuntil instead, as
+        Perl_sv_catpvf(aTHX_ sv, "-%s",reg_name[o->flags]);
+       /* print the details of the trie in dumpuntil instead, as
         * prog->data isn't available here */
     } else if (k == CURLY) {
        if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
@@ -5924,7 +6232,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
                    char *s = savesvpv(lv);
                    char * const origs = s;
                
-                   while(*s && *s != '\n') s++;
+                   while (*s && *s != '\n')
+                       s++;
                
                    if (*s == '\n') {
                        const char * const t = ++s;
@@ -6078,6 +6387,8 @@ Perl_pregfree(pTHX_ struct regexp *r)
                                SvREFCNT_dec((SV*)trie->widecharmap);
                            Safefree(trie->states);
                            Safefree(trie->trans);
+                            if (trie->bitmap)
+                                Safefree(trie->bitmap);
 #ifdef DEBUGGING
                            if (trie->words)
                                SvREFCNT_dec((SV*)trie->words);
@@ -6229,6 +6540,14 @@ S_put_byte(pTHX_ SV *sv, int c)
 }
 
 
+#define CLEAR_OPTSTART \
+    if (optstart) STMT_START { \
+           PerlIO_printf(Perl_debug_log, " (%d nodes)\n", node - optstart); \
+           optstart=NULL; \
+    } STMT_END
+
+#define DUMPUNTIL(a,b,c,d,e,f) CLEAR_OPTSTART; node=dumpuntil(a,b,c,d,e,f);
+
 STATIC const regnode *
 S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
            const regnode *last, SV* sv, I32 l)
@@ -6236,6 +6555,8 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
     dVAR;
     register U8 op = EXACT;    /* Arbitrary non-END op. */
     register const regnode *next;
+    const regnode *optstart= NULL;
+    GET_RE_DEBUG_FLAGS_DECL;
 
     while (op != END && (!last || node < last)) {
        /* While that wasn't END last time... */
@@ -6246,16 +6567,25 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
            l--;        
        next = regnext((regnode *)node);
        /* Where, what. */
-       if (OP(node) == OPTIMIZED)
+       if ( OP(node) == OPTIMIZED) {
+           if (!optstart && (SvIV(re_debug_flags) & RE_DEBUG_OPTIMISE))
+               optstart= node;
+           else
            goto after_print;
+       } else
+           CLEAR_OPTSTART;
        regprop(r, sv, node);
        PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
                      (int)(2*l + 1), "", SvPVX_const(sv));
+
+       if (OP(node) != OPTIMIZED) {
        if (next == NULL)               /* Next ptr. */
            PerlIO_printf(Perl_debug_log, "(0)");
        else
            PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start));
        (void)PerlIO_putc(Perl_debug_log, '\n');
+       }
+
       after_print:
        if (PL_regkind[(U8)op] == BRANCHJ) {
            register const regnode *nnode = (OP(next) == LONGJMP
@@ -6263,10 +6593,10 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
                                             : next);
            if (last && nnode > last)
                nnode = last;
-           node = dumpuntil(r, start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
+           DUMPUNTIL(r, start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
        }
        else if (PL_regkind[(U8)op] == BRANCH) {
-           node = dumpuntil(r, start, NEXTOPER(node), next, sv, l + 1);
+           DUMPUNTIL(r, start, NEXTOPER(node), next, sv, l + 1);
        }
        else if ( PL_regkind[(U8)op]  == TRIE ) {
             const I32 n = ARG(node);
@@ -6274,14 +6604,39 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
             const I32 arry_len = av_len(trie->words)+1;
            I32 word_idx;
            PerlIO_printf(Perl_debug_log,
-                      "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n",
+                       "%*s[Start:%d Words:%d Chars:%d Unique:%d States:%"IVdf" Minlen:%d Maxlen:%d",
                       (int)(2*(l+3)),
                       "",
-                      trie->wordcount,
-                      (int)trie->charcount,
+                      trie->startstate,
+                       TRIE_WORDCOUNT(trie),
+                       (int)TRIE_CHARCOUNT(trie),
                       trie->uniquecharcount,
-                      (IV)trie->laststate-1,
-                      node->flags ? " EVAL mode" : "");
+                       (IV)TRIE_LASTSTATE(trie)-1,
+                       trie->minlen, trie->maxlen 
+                      );
+           if (trie->bitmap) {
+                int i;
+                int rangestart= -1;
+                sv_setpvn(sv, "", 0);
+               for (i = 0; i <= 256; i++) {
+                   if (i < 256 && TRIE_BITMAP_TEST(trie,i)) {
+                       if (rangestart == -1)
+                           rangestart = i;
+                   } else if (rangestart != -1) {
+                       if (i <= rangestart + 3)
+                           for (; rangestart < i; rangestart++)
+                               put_byte(sv, rangestart);
+                       else {
+                           put_byte(sv, rangestart);
+                           sv_catpvs(sv, "-");
+                           put_byte(sv, i - 1);
+                       }
+                       rangestart = -1;
+                   }
+               }
+               PerlIO_printf(Perl_debug_log, " Start-Class:%s]\n", SvPVX_const(sv));
+            } else
+                PerlIO_printf(Perl_debug_log, " No Start-Class]\n");
 
            for (word_idx=0; word_idx < arry_len; word_idx++) {
                SV ** const elem_ptr = av_fetch(trie->words,word_idx,0);
@@ -6307,15 +6662,15 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
 
        }
        else if ( op == CURLY) {   /* "next" might be very big: optimizer */
-           node = dumpuntil(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
+           DUMPUNTIL(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
                             NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
        }
        else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) {
-           node = dumpuntil(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
+           DUMPUNTIL(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
                             next, sv, l + 1);
        }
        else if ( op == PLUS || op == STAR) {
-           node = dumpuntil(r, start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
+           DUMPUNTIL(r, start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1);
        }
        else if (op == ANYOF) {
            /* arglen 1 + class block */
@@ -6337,6 +6692,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
        else if (op == WHILEM)
            l--;
     }
+    CLEAR_OPTSTART;
     return node;
 }
 
index 7554a02..62e7691 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
@@ -311,11 +311,11 @@ struct regnode_charclass_class {  /* has [[:blah:]] classes */
 
 #define EXTRA_SIZE(guy) ((sizeof(guy)-1)/sizeof(struct regnode))
 
-#define REG_SEEN_ZERO_LEN       1
-#define REG_SEEN_LOOKBEHIND     2
-#define REG_SEEN_GPOS           4
-#define REG_SEEN_EVAL           8
-#define REG_SEEN_CANY          16
+#define REG_SEEN_ZERO_LEN      0x00000001
+#define REG_SEEN_LOOKBEHIND    0x00000002
+#define REG_SEEN_GPOS          0x00000004
+#define REG_SEEN_EVAL          0x00000008
+#define REG_SEEN_CANY          0x00000010
 #define REG_SEEN_SANY          REG_SEEN_CANY /* src bckwrd cmpt */
 
 START_EXTERN_C
@@ -362,7 +362,7 @@ typedef struct re_scream_pos_data_s
  *   f - start-class data for regstclass optimization
  *   n - Root of op tree for (?{EVAL}) item
  *   o - Start op for (?{EVAL}) item
- *   p - Pad for (?{EVAL} item
+ *   p - Pad for (?{EVAL}) item
  *   s - swash for unicode-style character class, and the multicharacter
  *       strings resulting from casefolding the single-character entries
  *       in the character class
@@ -445,28 +445,53 @@ typedef struct _reg_trie_trans    reg_trie_trans;
 should be dealt with in pregfree */
 struct _reg_trie_data {
     U16              uniquecharcount;
-    U16              wordcount;
-    STRLEN           charcount;
-    U32              laststate;
     U32              lasttrans;
     U16              *charmap;
     HV               *widecharmap;
     reg_trie_state   *states;
     reg_trie_trans   *trans;
+    char             *bitmap;
     U32              refcount;
+    U32              startstate;
+    STRLEN           minlen;     
+    STRLEN           maxlen;     
 #ifdef DEBUGGING
+    U16              wordcount;   /* Build only */
+    STRLEN           charcount;   /* Build only */
+    U32              laststate;   /* Build only */
     AV               *words;
     AV               *revcharmap;
 #endif
 };
-
 typedef struct _reg_trie_data reg_trie_data;
 
+/* ANY_BIT doesnt use the structure, so we can borrow it here.
+   This is simpler than refactoring all of it as wed end up with
+   three different sets... */
+
+#define TRIE_BITMAP(p)         (((reg_trie_data *)(p))->bitmap)
+#define TRIE_BITMAP_BYTE(p, c) (TRIE_BITMAP(p)[((c) >> 3) & 31])
+#define TRIE_BITMAP_SET(p, c)  (TRIE_BITMAP_BYTE(p, c) |=  ANYOF_BIT(c))
+#define TRIE_BITMAP_CLEAR(p,c) (TRIE_BITMAP_BYTE(p, c) &= ~ANYOF_BIT(c))
+#define TRIE_BITMAP_TEST(p, c) (TRIE_BITMAP_BYTE(p, c) &   ANYOF_BIT(c))
+
+
 /* 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))
 
+#ifdef DEBUGGING
+#define TRIE_WORDCOUNT(trie) ((trie)->wordcount)
+#define TRIE_CHARCOUNT(trie) ((trie)->charcount)
+#define TRIE_LASTSTATE(trie) ((trie)->laststate)
+#define TRIE_REVCHARMAP(trie) ((trie)->revcharmap)
+#else
+#define TRIE_WORDCOUNT(trie) (trie_wordcount)
+#define TRIE_CHARCOUNT(trie) (trie_charcount)
+#define TRIE_LASTSTATE(trie) (trie_laststate)
+#define TRIE_REVCHARMAP(trie) (trie_revcharmap)
+#endif
 #define DO_TRIE 1
 #define TRIE_DEBUG 1
 
@@ -475,14 +500,17 @@ typedef struct _reg_trie_data reg_trie_data;
 #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 RE_DEBUG_COMPILE       0x0001
+#define RE_DEBUG_EXECUTE       0x0002
+#define RE_DEBUG_TRIE_COMPILE  0x0004
+#define RE_DEBUG_TRIE_EXECUTE  0x0008
+#define RE_DEBUG_TRIE_MORE     0x0010
+#define RE_DEBUG_OPTIMISE      0x0020
+#define RE_DEBUG_OFFSETS       0x0040
+#define RE_DEBUG_PARSE         0x0080
+
 
+#define DEBUG_PARSE_r(x) DEBUG_r( if (SvIV(re_debug_flags) & RE_DEBUG_PARSE) x  )
 #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  )
@@ -507,7 +535,7 @@ typedef struct _reg_trie_data reg_trie_data;
 #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); \
+            sv_setiv(re_debug_flags, RE_DEBUG_COMPILE | RE_DEBUG_EXECUTE ); \
         } \
     )
 
index e7a9d05..144cb0c 100644 (file)
@@ -16,6 +16,8 @@ while (<DESC>) {
 }
 close DESC;
 $tot = $ind;
+die "Too many regexp opcodes! Maximum is 256, but there are $tot in file!"
+    if $tot>256;
 
 $tmp_h = 'tmp_reg.h';
 
index 19d729e..1a2bd31 100644 (file)
@@ -3,6 +3,11 @@
 
 # Empty rows and #-comment rows are ignored.
 
+# Note that the order in this file is important.
+#
+# Add new regops to the end, and do not re-order the existing ops.
+#
+
 # Exit points
 END            END,    no      End of program.
 SUCCEED                END,    no      Return from a subroutine, basically.
@@ -116,7 +121,12 @@ RENUM              BRANCHJ,off 1 1 Group with independently numbered parens.
 OPTIMIZED      NOTHING,off     Placeholder for dump.
 
 # 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
-
+TRIE           TRIE,   trie 1  Match many EXACT(FL?)? at once. flags==type
+TRIEC          TRIE,   trie 1  Trie + charclass. (unused at present)
+
+# Special opcode with the property that no opcode in a compiled program
+# will ever be of this type. Thus it can be used as a flag value that
+# no other opcode has been seen. END is used similarly, in that an END
+# node cant be optimized. So END implies "unoptimizable" and PSEUDO mean
+# "not seen anything to optimize yet".
+PSEUDO         PSEUDO,off      Pseudo opcode for internal use.
index 0f5d6fb..535bb74 100644 (file)
--- a/regexec.c
+++ b/regexec.c
 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
 
-#define HOPc(pos,off) ((char *)(PL_reg_match_utf8 \
+#define HOPc(pos,off) \
+       (char *)(PL_reg_match_utf8 \
            ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
-           : (U8*)(pos + off)))
-#define HOPBACKc(pos, off) ((char*)    \
-    ((PL_reg_match_utf8)               \
+           : (U8*)(pos + off))
+#define HOPBACKc(pos, off) \
+       (char*)(PL_reg_match_utf8\
        ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
     : (pos - off >= PL_bostr)          \
-       ? (U8*)(pos - off)              \
-    : (U8*)NULL)                       \
-)
+               ? pos - off             \
+               : NULL)
 
 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
 
+/* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */
+
 /* for use after a quantifier and before an EXACT-like node -- japhy */
 #define JUMPABLE(rn) ( \
     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
     OP(rn) == PLUS || OP(rn) == MINMOD || \
-    (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
+    (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \
 )
 
 #define HAS_TEXT(rn) ( \
-    PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
+    PL_regkind[OP(rn)] == EXACT || PL_regkind[OP(rn)] == REF \
 )
 
 /*
   follow but for lookbehind (rn->flags != 0) we skip to the next step.
 */
 #define FIND_NEXT_IMPT(rn) STMT_START { \
-    while (JUMPABLE(rn)) \
-       if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
+    while (JUMPABLE(rn)) { \
+       const OPCODE type = OP(rn); \
+       if (type == SUSPEND || PL_regkind[type] == CURLY) \
            rn = NEXTOPER(NEXTOPER(rn)); \
-       else if (OP(rn) == PLUS) \
+       else if (type == PLUS) \
            rn = NEXTOPER(rn); \
-       else if (OP(rn) == IFMATCH) \
+       else if (type == IFMATCH) \
            rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
        else rn += NEXT_OFF(rn); \
+    } \
 } STMT_END 
 
 static void restore_pos(pTHX_ void *arg);
@@ -811,7 +815,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
        /* If regstclass takes bytelength more than 1: If charlength==1, OK.
           This leaves EXACTF only, which is dealt with in find_byclass().  */
         const U8* const str = (U8*)STRING(prog->regstclass);
-        const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
+        const int cl_l = (PL_regkind[OP(prog->regstclass)] == EXACT
                    ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
                    : 1);
        const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
@@ -1045,8 +1049,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char
                                           uniflags);
                        if ( c == c1
                             && (ln == len ||
-                                ibcmp_utf8(s, (char **)0, 0,  do_utf8,
-                                           m, (char **)0, ln, (bool)UTF))
+                                ibcmp_utf8(s, NULL, 0,  do_utf8,
+                                           m, NULL, ln, (bool)UTF))
                             && (!reginfo || regtry(reginfo, s)) )
                            goto got_it;
                        else {
@@ -1057,9 +1061,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char
                                  && (f == c1 || f == c2)
                                  && (ln == foldlen ||
                                      !ibcmp_utf8((char *) foldbuf,
-                                                 (char **)0, foldlen, do_utf8,
+                                                 NULL, foldlen, do_utf8,
                                                  m,
-                                                 (char **)0, ln, (bool)UTF))
+                                                 NULL, ln, (bool)UTF))
                                  && (!reginfo || regtry(reginfo, s)) )
                                  goto got_it;
                        }
@@ -1084,8 +1088,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char
 
                        if ( (c == c1 || c == c2)
                             && (ln == len ||
-                                ibcmp_utf8(s, (char **)0, 0,  do_utf8,
-                                           m, (char **)0, ln, (bool)UTF))
+                                ibcmp_utf8(s, NULL, 0,  do_utf8,
+                                           m, NULL, ln, (bool)UTF))
                             && (!reginfo || regtry(reginfo, s)) )
                            goto got_it;
                        else {
@@ -1096,9 +1100,9 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char
                                  && (f == c1 || f == c2)
                                  && (ln == foldlen ||
                                      !ibcmp_utf8((char *) foldbuf,
-                                                 (char **)0, foldlen, do_utf8,
+                                                 NULL, foldlen, do_utf8,
                                                  m,
-                                                 (char **)0, ln, (bool)UTF))
+                                                 NULL, ln, (bool)UTF))
                                  && (!reginfo || regtry(reginfo, s)) )
                                  goto got_it;
                        }
@@ -1589,7 +1593,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     I32 end_shift = 0;                 /* Same for the end. */         /* CC */
     I32 scream_pos = -1;               /* Internal iterator of scream. */
     char *scream_olds = NULL;
-    SV* oreplsv = GvSV(PL_replgv);
+    SV* const oreplsv = GvSV(PL_replgv);
     const bool do_utf8 = DO_UTF8(sv);
     I32 multiline;
 #ifdef DEBUGGING
@@ -1889,7 +1893,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
     }
     else if ((c = prog->regstclass)) {
        if (minlen) {
-           I32 op = (U8)OP(prog->regstclass);
+           I32 op = OP(prog->regstclass);
            /* don't bother with what can't match */
            if (PL_regkind[op] != EXACT && op != CANY)
                strend = HOPc(strend, -(minlen - 1));
@@ -2090,7 +2094,7 @@ S_regtry(pTHX_ const regmatch_info *reginfo, char *startpos)
                if (SvIsCOW(sv))
                    sv_force_normal_flags(sv, 0);
 #endif
-               mg = sv_magicext(reginfo->sv, (SV*)0, PERL_MAGIC_regex_global,
+               mg = sv_magicext(reginfo->sv, NULL, PERL_MAGIC_regex_global,
                                 &PL_vtbl_mglob, NULL, 0);
                mg->mg_len = -1;
            }
@@ -2458,6 +2462,7 @@ S_push_slab(pTHX)
  * allocated since entry are freed.
  */
  
+#define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
 
 STATIC I32                     /* 0 failure, 1 success */
 S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
@@ -2671,15 +2676,40 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
        /*
           traverse the TRIE keeping track of all accepting states
           we transition through until we get to a failing node.
-
-
        */
        case TRIE:
-       case TRIEF:
-       case TRIEFL:
+           {
+               const enum { trie_plain, trie_utf8, trie_utf8_fold }
+                   trie_type = do_utf8 ?
+                         (scan->flags == EXACT ? trie_utf8 : trie_utf8_fold)
+                       : trie_plain;
+
+                /* what trie are we using right now */
+               reg_trie_data *trie
+                   = (reg_trie_data*)rex->data->data[ ARG( scan ) ];
+                U32 state = trie->startstate;
+                
+               if (trie->bitmap && trie_type != trie_utf8_fold &&
+                   !TRIE_BITMAP_TEST(trie,*locinput)
+               ) {
+                   if (trie->states[ state ].wordnum) {
+                        DEBUG_EXECUTE_r(
+                            PerlIO_printf(Perl_debug_log,
+                                         "%*s  %smatched empty string...%s\n",
+                                         REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
+                        );
+                       break;
+                   } else {
+                       DEBUG_EXECUTE_r(
+                            PerlIO_printf(Perl_debug_log,
+                                         "%*s  %sfailed to match start class...%s\n",
+                                         REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
+                        );
+                       sayNO_SILENT;
+                  }
+                }
            {
                U8 *uc = ( U8* )locinput;
-               U32 state = 1;
                U16 charid = 0;
                U32 base = 0;
                UV uvc = 0;
@@ -2688,14 +2718,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                U8 *uscan = (U8*)NULL;
                STRLEN bufflen=0;
                SV *sv_accept_buff = NULL;
-               const enum { trie_plain, trie_utf8, trie_uft8_fold }
-                   trie_type = do_utf8 ?
-                         (OP(scan) == TRIE ? trie_utf8 : trie_uft8_fold)
-                       : trie_plain;
 
-               /* what trie are we using right now */
-               reg_trie_data *trie
-                   = (reg_trie_data*)rex->data->data[ ARG( scan ) ];
                st->u.trie.accepted = 0; /* how many accepting states we have seen */
                result = 0;
 
@@ -2741,7 +2764,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
                    if ( base ) {
                        switch (trie_type) {
-                       case trie_uft8_fold:
+                       case trie_utf8_fold:
                            if ( foldlen>0 ) {
                                uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
                                foldlen -= len;
@@ -2770,8 +2793,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                        else {
                            charid = 0;
                            if (trie->widecharmap) {
-                               SV** svpp = (SV**)NULL;
-                               svpp = hv_fetch(trie->widecharmap,
+                               SV** const svpp = hv_fetch(trie->widecharmap,
                                            (char*)&uvc, sizeof(UV), 0);
                                if (svpp)
                                    charid = (U16)SvIV(*svpp);
@@ -2862,10 +2884,10 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                            reg_trie_data * const trie = (reg_trie_data*)
                                            rex->data->data[ARG(scan)];
                            SV ** const tmp = av_fetch( trie->words, st->u.trie.accept_buff[ best ].wordnum - 1, 0 );
-                           PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
+                           PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at node #%d %s\n",
                                REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
                                st->u.trie.accept_buff[best].wordnum,
-                               tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr", (void*)scan,
+                               tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr", REG_NODE_NUM(scan),
                                PL_colors[5] );
                        });
                        if ( best<st->u.trie.accepted ) {
@@ -2895,7 +2917,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                } else {
                    sayNO;
                }
-           }
+           }}
            /* unreached codepoint */
        case EXACT: {
            char *s = STRING(scan);
@@ -3914,9 +3936,10 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
            st->u.curlym.c1 = st->u.curlym.c2 = CHRTEST_VOID;
            if (HAS_TEXT(next) || JUMPABLE(next)) {
                regnode *text_node = next;
-               if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
+               if (! HAS_TEXT(text_node)) 
+                   FIND_NEXT_IMPT(text_node);
                if (HAS_TEXT(text_node)
-                   && PL_regkind[(U8)OP(text_node)] != REF)
+                   && PL_regkind[OP(text_node)] != REF)
                {
                    st->u.curlym.c1 = (U8)*STRING(text_node);
                    st->u.curlym.c2 =
@@ -4037,12 +4060,13 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                U8 *s;
                regnode *text_node = next;
 
-               if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
+               if (! HAS_TEXT(text_node)) 
+                   FIND_NEXT_IMPT(text_node);
 
                if (! HAS_TEXT(text_node))
                    st->u.plus.c1 = st->u.plus.c2 = CHRTEST_VOID;
                else {
-                   if (PL_regkind[(U8)OP(text_node)] == REF) {
+                   if (PL_regkind[OP(text_node)] == REF) {
                        st->u.plus.c1 = st->u.plus.c2 = CHRTEST_VOID;
                        goto assume_ok_easy;
                    }
@@ -4209,9 +4233,8 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
            else {
                n = regrepeat(rex, scan, n);
                locinput = PL_reginput;
-               if (st->ln < n && PL_regkind[(U8)OP(next)] == EOL &&
-                   (OP(next) != MEOL ||
-                       OP(next) == SEOL || OP(next) == EOS))
+               if ((st->ln < n) && (PL_regkind[OP(next)] == EOL) &&
+                   (OP(next) != MEOL || OP(next) == SEOL || OP(next) == EOS))
                {
                    st->ln = n;                 /* why back off? */
                    /* ...because $ and \Z can match before *and* after
@@ -4286,7 +4309,7 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
                    /* trivial fail */
                    if (st->logical) {
                        st->logical = 0;
-                       st->sw = 1 - st->u.ifmatch.wanted;
+                       st->sw = 1 - (bool)st->u.ifmatch.wanted;
                    }
                    else if (st->u.ifmatch.wanted)
                        sayNO;
@@ -4421,7 +4444,7 @@ yes_final:
        case resume_IFMATCH:
            if (st->logical) {
                st->logical = 0;
-               st->sw = st->u.ifmatch.wanted;
+               st->sw = (bool)st->u.ifmatch.wanted;
            }
            else if (!st->u.ifmatch.wanted)
                sayNO;
@@ -4932,7 +4955,7 @@ Perl_regclass_swash(pTHX_ const regexp *prog, register const regnode* node, bool
     SV *sw  = NULL;
     SV *si  = NULL;
     SV *alt = NULL;
-    const struct reg_data *data = prog ? prog->data : NULL;
+    const struct reg_data * const data = prog ? prog->data : NULL;
 
     if (data && data->count) {
        const U32 n = ARG(node);
@@ -5138,7 +5161,7 @@ S_reghopmaybe3(U8* s, I32 off, const U8* lim)
            s += UTF8SKIP(s);
        }
        if (off >= 0)
-           return 0;
+           return NULL;
     }
     else {
        while (off++) {
@@ -5154,7 +5177,7 @@ S_reghopmaybe3(U8* s, I32 off, const U8* lim)
                break;
        }
        if (off <= 0)
-           return 0;
+           return NULL;
     }
     return s;
 }
index 03afa19..394a665 100644 (file)
@@ -958,8 +958,8 @@ x(?#        x       c       -       Sequence (?#... not terminated
 (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)(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       -       -
 ^(a*?)(?!(aa|aaaa)*$)  aaaaaaaaaaaaaaaaaaaa    y       $1      a       # [perl #34195]
 ^(a*?)(?!(aa|aaaa)*$)(?=a\z)   aaaaaaaa        y       $1      aaaaaaa
@@ -969,3 +969,5 @@ x(?#        x       c       -       Sequence (?#... not terminated
 ^(a*?)(?!(a{6}|a{5})*$)        aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa y       $+[1]   12      # super-linear cache bug may return 18
 ^((?>(?:aa)?b)?)       aab     y       $1      aab
 ^((?:aa)*)(?:X+((?:\d+|-)(?:X+(.+))?))?$       aaaaX5  y       $1      aaaa
+X(A|B||C|D)Y   XXXYYY  y       $&      XY      # Trie w/ NOTHING
+(?i:X([A]|[B]|y[Y]y|[D]|)Y)    XXXYYYB y       $&      XY      # Trie w/ NOTHING