From: Yves Orton Date: Fri, 29 Sep 2006 17:39:16 +0000 (+0200) Subject: Minor re 'Debug' tweaks, also fix a bug in dumping certain patterns. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a5ca303d52a1ef183f2014497a2d96212f0b1dd4;p=p5sagit%2Fp5-mst-13.2.git Minor re 'Debug' tweaks, also fix a bug in dumping certain patterns. Message-ID: <9b18b3110609290839i58fa703u59259e4ec1d9f2d9@mail.gmail.com> p4raw-id: //depot/perl@28904 --- diff --git a/ext/re/re.pm b/ext/re/re.pm index 9fab039..87a450d 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -1,6 +1,6 @@ package re; -our $VERSION = 0.06_01; +our $VERSION = 0.06_02; =head1 NAME @@ -225,25 +225,26 @@ my %flags = ( COMPILE => 0x0000FF, PARSE => 0x000001, OPTIMISE => 0x000002, - TRIE_COMPILE => 0x000004, + TRIEC => 0x000004, DUMP => 0x000008, - OFFSETS => 0x000010, EXECUTE => 0x00FF00, INTUIT => 0x000100, MATCH => 0x000200, - TRIE_EXECUTE => 0x000400, + TRIEE => 0x000400, EXTRA => 0xFF0000, - TRIE_MORE => 0x010000, - OFFSETS_DEBUG => 0x020000, - STATE => 0x040000, + TRIEM => 0x010000, + OFFSETS => 0x020000, + OFFSETSDBG => 0x040000, + STATE => 0x080000, + OPTIMISEM => 0x100000, ); $flags{ALL} = -1; $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE}; -$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIE_MORE} | $flags{STATE}; +$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE}; $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE}; -$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIE_COMPILE}; +$flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC}; my $installed =eval { require XSLoader; diff --git a/regcomp.c b/regcomp.c index 9f92af8..2b38a41 100644 --- a/regcomp.c +++ b/regcomp.c @@ -525,7 +525,7 @@ static const scan_data_t zero_scan_data = #endif #define DEBUG_STUDYDATA(data,depth) \ -DEBUG_OPTIMISE_r(if(data){ \ +DEBUG_OPTIMISE_MORE_r(if(data){ \ PerlIO_printf(Perl_debug_log, \ "%*s"/* Len:%"IVdf"/%"IVdf" */" Pos:%"IVdf"/%"IVdf \ " Flags: %"IVdf" Whilem_c: %"IVdf" Lcp: %"IVdf" ", \ @@ -1755,7 +1755,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs char *str=NULL; #ifdef DEBUGGING - + regnode *optimize; U32 mjd_offset = 0; U32 mjd_nodelen = 0; #endif @@ -1889,9 +1889,12 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs convert = n; } else { NEXT_OFF(convert) = (U16)(tail - convert); + DEBUG_r(optimize= n); } } } + if (!jumper) + jumper = last; if ( trie->maxlen ) { NEXT_OFF( convert ) = (U16)(tail - convert); ARG_SET( convert, data_slot ); @@ -1900,8 +1903,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs We use this when dumping a trie and during optimisation. */ if (trie->jump) trie->jump[0] = (U16)(tail - nextbranch); - if (!jumper) - jumper = last; + /* XXXX */ if ( !trie->states[trie->startstate].wordnum && trie->bitmap && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) ) @@ -1915,13 +1917,16 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs /* 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 */ + DEBUG_r({ + optimize = convert + + NODE_STEP_REGNODE + + regarglen[ OP( convert ) ]; + }); + /* XXX We really should free up the resource in trie now, + as we won't use them - (which resources?) dmq */ } /* needed for dumping*/ DEBUG_r({ - regnode *optimize = convert - + NODE_STEP_REGNODE - + regarglen[ OP( convert ) ]; regnode *opt = convert; while (++opt REGNODE_MAX) /* regnode.type is unsigned */ /* It would be nice to FAIL() here, but this may be called from regexec.c, and it would be hard to supply pRExC_state. */ - Perl_croak(aTHX_ "Corrupted regexp opcode"); + Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(o), (int)REGNODE_MAX); sv_catpv(sv, reg_name[OP(o)]); /* Take off const! */ k = PL_regkind[OP(o)]; diff --git a/regcomp.h b/regcomp.h index a3dc5d6..3213fc8 100644 --- a/regcomp.h +++ b/regcomp.h @@ -585,7 +585,6 @@ re.pm, especially to the documentation. #define RE_DEBUG_COMPILE_OPTIMISE 0x000002 #define RE_DEBUG_COMPILE_TRIE 0x000004 #define RE_DEBUG_COMPILE_DUMP 0x000008 -#define RE_DEBUG_COMPILE_OFFSETS 0x000010 /* Execute */ #define RE_DEBUG_EXECUTE_MASK 0x00FF00 @@ -597,7 +596,9 @@ re.pm, especially to the documentation. #define RE_DEBUG_EXTRA_MASK 0xFF0000 #define RE_DEBUG_EXTRA_TRIE 0x010000 #define RE_DEBUG_EXTRA_OFFSETS 0x020000 -#define RE_DEBUG_EXTRA_STATE 0x040000 +#define RE_DEBUG_EXTRA_OFFDEBUG 0x040000 +#define RE_DEBUG_EXTRA_STATE 0x080000 +#define RE_DEBUG_EXTRA_OPTIMISE 0x100000 #define RE_DEBUG_FLAG(x) (re_debug_flags & x) /* Compile */ @@ -611,8 +612,6 @@ re.pm, especially to the documentation. if (re_debug_flags & RE_DEBUG_COMPILE_PARSE) x ) #define DEBUG_DUMP_r(x) DEBUG_r( \ if (re_debug_flags & RE_DEBUG_COMPILE_DUMP) x ) -#define DEBUG_OFFSETS_r(x) DEBUG_r( \ - if (re_debug_flags & RE_DEBUG_COMPILE_OFFSETS) x ) #define DEBUG_TRIE_COMPILE_r(x) DEBUG_r( \ if (re_debug_flags & RE_DEBUG_COMPILE_TRIE) x ) @@ -629,10 +628,15 @@ re.pm, especially to the documentation. /* Extra */ #define DEBUG_EXTRA_r(x) DEBUG_r( \ if (re_debug_flags & RE_DEBUG_EXTRA_MASK) x ) +#define DEBUG_OFFSETS_r(x) DEBUG_r( \ + if (re_debug_flags & RE_DEBUG_EXTRA_OFFSETS) x ) #define DEBUG_STATE_r(x) DEBUG_r( \ if (re_debug_flags & RE_DEBUG_EXTRA_STATE) x ) +#define DEBUG_OPTIMISE_MORE_r(x) DEBUG_r( \ + if ((RE_DEBUG_EXTRA_OPTIMISE|RE_DEBUG_COMPILE_OPTIMISE) == \ + (re_debug_flags & (RE_DEBUG_EXTRA_OPTIMISE|RE_DEBUG_COMPILE_OPTIMISE)) ) x ) #define MJD_OFFSET_DEBUG(x) DEBUG_r( \ - if (re_debug_flags & RE_DEBUG_EXTRA_OFFSETS) \ + if (re_debug_flags & RE_DEBUG_EXTRA_OFFDEBUG) \ Perl_warn_nocontext x ) #define DEBUG_TRIE_COMPILE_MORE_r(x) DEBUG_TRIE_COMPILE_r( \ if (re_debug_flags & RE_DEBUG_EXTRA_TRIE) x ) diff --git a/win32/Makefile b/win32/Makefile index ce65ba6..b14f311 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -454,6 +454,7 @@ LIBBASEFILES = $(LIBBASEFILES) bufferoverflowU.lib # we add LIBC here, since we may be using PerlCRT.dll LIBFILES = $(LIBBASEFILES) $(LIBC) +#EXTRACFLAGS = -nologo -GF -W4 -wd4127 -wd4706 EXTRACFLAGS = -nologo -GF -W3 CFLAGS = $(EXTRACFLAGS) $(INCLUDES) $(DEFINES) $(LOCDEFS) \ $(PCHFLAGS) $(OPTIMIZE) @@ -1085,14 +1086,17 @@ MakePPPort_clean: #------------------------------------------------------------------------------- Extensions: buildext.pl $(PERLDEP) $(CONFIGPM) + $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic Extensions_reonly: buildext.pl $(PERLDEP) $(CONFIGPM) + $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --dynamic +re $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --dynamic +re Extensions_static : buildext.pl + $(XCOPY) ..\*.h $(COREDIR)\*.* $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) $(EXTDIR) --static $(MINIPERL) -I..\lib buildext.pl $(MAKE) $(PERLDEP) ext --static $(MINIPERL) -I..\lib buildext.pl --list-static-libs > Extensions_static @@ -1299,7 +1303,7 @@ test-reonly : reonly utils $(XCOPY) $(PERLDLL) ..\t\$(NULL) $(XCOPY) $(GLOBEXE) ..\t\$(NULL) cd ..\t - $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg + $(PERLEXE) -I..\lib harness $(OPT) -re \bpat\b \breg \bre\b $(EXTRA) cd ..\win32 test-notty : test-prep