From: Yves Orton Date: Sun, 28 May 2006 16:24:59 +0000 (+0200) Subject: Re: [PATCH] More regex optimisations and debug enhancements (including Andys stuff... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3dab1dad3c281a8a3802c3e053703d7cabca032a;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] More regex optimisations and debug enhancements (including Andys stuff too) Message-ID: <9b18b3110605280724u54a9c53bn3b20692b6fe4f1c3@mail.gmail.com> p4raw-id: //depot/perl@28325 --- diff --git a/MANIFEST b/MANIFEST index b677bfb..b527b9c 100644 --- 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 diff --git a/embed.fnc b/embed.fnc index 2050be8..edb4458 100644 --- 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) diff --git a/ext/re/re.pm b/ext/re/re.pm index fc78451..2da3a25 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -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 and its equivalents are I 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 index 0000000..05a34ad --- /dev/null +++ b/ext/re/t/regop.pl @@ -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 index 0000000..5947980 --- /dev/null +++ b/ext/re/t/regop.t @@ -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*\#/ } ); +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 (3) +# 3: OPEN1(5) +# 5: TRIE-EXACT(21) +# [Words:5 Chars:5 Unique:5 States:6 Start-Class:A-D] +# +# +# <> +# +# +# 21: CLOSE1(23) +# 23: EXACT (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 <> | 1: EXACT +# 1 | 3: OPEN1 +# 1 | 5: TRIE-EXACT +# matched empty string... +# 1 | 21: CLOSE1 +# 1 | 23: EXACT +# 2 <> | 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 + +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 (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 (3) +# 3: TRIE-EXACT(20) +# [Start:4 Words:6 Chars:24 Unique:7 States:10 Minlen:1 Maxlen:1 Start-Class:A-EGP] +# +# +# +# +# +# +# 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 <> | 1: EXACT +# 3 | 3: TRIE-EXACT +# only one match : #6 +# 4 <> | 20: END +#Match successful! +#POP STATE(1) +#%MATCHED% +#Freeing REx: "(?:ABCP|ABCG|ABCE|ABCB|ABCA|ABCD)" +%MATCHED% +EXACT +Start-Class:A-EGP +only one match : #6 +Start:4 +minlen 4 diff --git a/regcomp.c b/regcomp.c index 7849bd3..6f56929 100644 --- 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 (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 %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) \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; } diff --git a/regcomp.h b/regcomp.h index 7554a02..62e7691 100644 --- 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 ); \ } \ ) diff --git a/regcomp.pl b/regcomp.pl index e7a9d05..144cb0c 100644 --- a/regcomp.pl +++ b/regcomp.pl @@ -16,6 +16,8 @@ while () { } 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'; diff --git a/regcomp.sym b/regcomp.sym index 19d729e..1a2bd31 100644 --- a/regcomp.sym +++ b/regcomp.sym @@ -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. diff --git a/regexec.c b/regexec.c index 0f5d6fb..535bb74 100644 --- a/regexec.c +++ b/regexec.c @@ -99,16 +99,16 @@ #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)) @@ -120,16 +120,18 @@ #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 \ ) /* @@ -137,14 +139,16 @@ 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 ( bestu.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; } diff --git a/t/op/re_tests b/t/op/re_tests index 03afa19..394a665 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -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