Minor re 'Debug' tweaks, also fix a bug in dumping certain patterns.
Yves Orton [Fri, 29 Sep 2006 17:39:16 +0000 (19:39 +0200)]
Message-ID: <9b18b3110609290839i58fa703u59259e4ec1d9f2d9@mail.gmail.com>

p4raw-id: //depot/perl@28904

ext/re/re.pm
regcomp.c
regcomp.h
win32/Makefile

index 9fab039..87a450d 100644 (file)
@@ -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;
index 9f92af8..2b38a41 100644 (file)
--- 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<optimize) {
                 Set_Node_Offset_Length(opt,0,0);
@@ -7294,7 +7299,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
     if (OP(o) > 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)];
index a3dc5d6..3213fc8 100644 (file)
--- 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 )
index ce65ba6..b14f311 100644 (file)
@@ -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