This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move the RXf_ANCH flags to intflags as PREGf_ANCH_xxx and add RXf_IS_ANCHORED as...
authorYves Orton <yves.orton@booking.com>
Thu, 30 Jan 2014 20:43:06 +0000 (04:43 +0800)
committerYves Orton <yves.orton@booking.com>
Thu, 30 Jan 2014 20:43:06 +0000 (04:43 +0800)
The only requirement outside of the regex engine is to identify that there is
an anchor involved at all. So we move the 4 anchor flags to intflags and replace
it with a single aggregate flag RXf_IS_ANCHORED in extflags.

This frees up another 3 bits in extflags.

dump.c
pp.c
regcomp.c
regcomp.h
regexec.c
regexp.h
regnodes.h

diff --git a/dump.c b/dump.c
index eb050b3..412cfc3 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1551,10 +1551,7 @@ const struct flag_to_name regexp_extflags_names[] = {
     {RXf_PMf_FOLD,        "PMf_FOLD,"},
     {RXf_PMf_EXTENDED,    "PMf_EXTENDED,"},
     {RXf_PMf_KEEPCOPY,    "PMf_KEEPCOPY,"},
-    {RXf_ANCH_BOL,        "ANCH_BOL,"},
-    {RXf_ANCH_MBOL,       "ANCH_MBOL,"},
-    {RXf_ANCH_SBOL,       "ANCH_SBOL,"},
-    {RXf_ANCH_GPOS,       "ANCH_GPOS,"},
+    {RXf_IS_ANCHORED,     "IS_ANCHORED,"},
     {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
     {RXf_EVAL_SEEN,       "EVAL_SEEN,"},
     {RXf_CHECK_ALL,       "CHECK_ALL,"},
@@ -1586,6 +1583,10 @@ const struct flag_to_name regexp_core_intflags_names[] = {
     {PREGf_CANY_SEEN,       "CANY_SEEN,"},
     {PREGf_GPOS_SEEN,       "GPOS_SEEN,"},
     {PREGf_GPOS_FLOAT,      "GPOS_FLOAT,"},
+    {PREGf_ANCH_BOL,        "ANCH_BOL,"},
+    {PREGf_ANCH_MBOL,       "ANCH_MBOL,"},
+    {PREGf_ANCH_SBOL,       "ANCH_SBOL,"},
+    {PREGf_ANCH_GPOS,       "ANCH_GPOS,"},
 };
 
 void
diff --git a/pp.c b/pp.c
index f9f0b5b..b882fb3 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -5644,7 +5644,7 @@ PP(pp_split)
     else if (do_utf8 == (RX_UTF8(rx) != 0) &&
             (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
             && (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
-            && !(RX_EXTFLAGS(rx) & RXf_ANCH)) {
+             && !(RX_EXTFLAGS(rx) & RXf_IS_ANCHORED)) {
        const int tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL);
        SV * const csv = CALLREG_INTUIT_STRING(rx);
 
index d05df22..7fa4473 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -5183,8 +5183,8 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVdf" RHS=%"UVdf"\n",
             if (!(RExC_rx->intflags & PREGf_GPOS_FLOAT) &&
                !(delta || is_inf || (data && data->pos_delta)))
            {
-               if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
-                   RExC_rx->extflags |= RXf_ANCH_GPOS;
+                if (!(RExC_rx->intflags & PREGf_ANCH) && (flags & SCF_DO_SUBSTR))
+                    RExC_rx->intflags |= PREGf_ANCH_GPOS;
                if (RExC_rx->gofs < (STRLEN)min)
                    RExC_rx->gofs = min;
             } else {
@@ -6752,31 +6752,30 @@ reStudy:
                 PL_regkind[OP(first)] == NBOUND)
            ri->regstclass = first;
        else if (PL_regkind[OP(first)] == BOL) {
-           r->extflags |= (OP(first) == MBOL
-                          ? RXf_ANCH_MBOL
+            r->intflags |= (OP(first) == MBOL
+                           ? PREGf_ANCH_MBOL
                           : (OP(first) == SBOL
-                             ? RXf_ANCH_SBOL
-                             : RXf_ANCH_BOL));
+                              ? PREGf_ANCH_SBOL
+                              : PREGf_ANCH_BOL));
            first = NEXTOPER(first);
            goto again;
        }
        else if (OP(first) == GPOS) {
-           r->extflags |= RXf_ANCH_GPOS;
+            r->intflags |= PREGf_ANCH_GPOS;
            first = NEXTOPER(first);
            goto again;
        }
        else if ((!sawopen || !RExC_sawback) &&
            (OP(first) == STAR &&
            PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
-           !(r->extflags & RXf_ANCH) && !pRExC_state->num_code_blocks)
+            !(r->intflags & PREGf_ANCH) && !pRExC_state->num_code_blocks)
        {
            /* turn .* into ^.* with an implied $*=1 */
            const int type =
                (OP(NEXTOPER(first)) == REG_ANY)
-                   ? RXf_ANCH_MBOL
-                   : RXf_ANCH_SBOL;
-           r->extflags |= type;
-           r->intflags |= PREGf_IMPLICIT;
+                    ? PREGf_ANCH_MBOL
+                    : PREGf_ANCH_SBOL;
+            r->intflags |= (type | PREGf_IMPLICIT);
            first = NEXTOPER(first);
            goto again;
        }
@@ -6846,7 +6845,7 @@ reStudy:
             && data.last_start_min == 0 && data.last_end > 0
             && !RExC_seen_zerolen
             && !(RExC_seen & REG_SEEN_VERBARG)
-            && !((RExC_seen & REG_SEEN_GPOS) || (r->extflags & RXf_ANCH_GPOS)))
+             && !((RExC_seen & REG_SEEN_GPOS) || (r->intflags & PREGf_ANCH_GPOS)))
            r->extflags |= RXf_CHECK_ALL;
        scan_commit(pRExC_state, &data,&minlen,0);
 
@@ -6935,7 +6934,7 @@ reStudy:
            r->check_substr = r->anchored_substr;
            r->check_utf8 = r->anchored_utf8;
            r->check_offset_min = r->check_offset_max = r->anchored_offset;
-           if (r->extflags & RXf_ANCH_SINGLE)
+            if (r->intflags & PREGf_ANCH_SINGLE)
                 r->intflags |= PREGf_NOSCAN;
        }
        else {
@@ -7038,6 +7037,11 @@ reStudy:
     else
         RXp_PAREN_NAMES(r) = NULL;
 
+    /* If we have seen an anchor in our pattern then we set the extflag RXf_IS_ANCHORED
+     * so it can be used in pp.c */
+    if (r->intflags & PREGf_ANCH)
+        r->extflags |= RXf_IS_ANCHORED;
+
     {
         regnode *first = ri->program + 1;
         U8 fop = OP(first);
@@ -15402,15 +15406,15 @@ Perl_regdump(pTHX_ const regexp *r)
        regprop(r, sv, ri->regstclass);
        PerlIO_printf(Perl_debug_log, "stclass %s ", SvPVX_const(sv));
     }
-    if (r->extflags & RXf_ANCH) {
+    if (r->intflags & PREGf_ANCH) {
        PerlIO_printf(Perl_debug_log, "anchored");
-       if (r->extflags & RXf_ANCH_BOL)
+        if (r->intflags & PREGf_ANCH_BOL)
            PerlIO_printf(Perl_debug_log, "(BOL)");
-       if (r->extflags & RXf_ANCH_MBOL)
+        if (r->intflags & PREGf_ANCH_MBOL)
            PerlIO_printf(Perl_debug_log, "(MBOL)");
-       if (r->extflags & RXf_ANCH_SBOL)
+        if (r->intflags & PREGf_ANCH_SBOL)
            PerlIO_printf(Perl_debug_log, "(SBOL)");
-       if (r->extflags & RXf_ANCH_GPOS)
+        if (r->intflags & PREGf_ANCH_GPOS)
            PerlIO_printf(Perl_debug_log, "(GPOS)");
        PerlIO_putc(Perl_debug_log, ' ');
     }
index a5f04fa..7a430eb 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
 /* these used to be extflags, but are now intflags */
 #define PREGf_NOSCAN            0x00000040
 #define PREGf_CANY_SEEN         0x00000080
-#define PREGf_GPOS_SEEN           0x00000100
-#define PREGf_GPOS_FLOAT          0x00000200
+#define PREGf_GPOS_SEEN         0x00000100
+#define PREGf_GPOS_FLOAT        0x00000200
 
+#define PREGf_ANCH_BOL          0x00000400
+#define PREGf_ANCH_MBOL         0x00000800
+#define PREGf_ANCH_SBOL         0x00001000
+#define PREGf_ANCH_GPOS         0x00002000
+
+#define PREGf_ANCH_SINGLE       ( PREGf_ANCH_SBOL | PREGf_ANCH_GPOS )
+#define PREGf_ANCH              ( PREGf_ANCH_SINGLE | PREGf_ANCH_MBOL | PREGf_ANCH_BOL )
 
 /* this is where the old regcomp.h started */
 
index 666a280..36c3805 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -677,15 +677,15 @@ Perl_re_intuit_start(pTHX_
         }
        check = prog->check_substr;
     }
-    if (prog->extflags & RXf_ANCH) { /* Match at \G, beg-of-str or after \n */
-       ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
-                    || ( (prog->extflags & RXf_ANCH_BOL)
+    if (prog->intflags & PREGf_ANCH) { /* Match at \G, beg-of-str or after \n */
+        ml_anch = !( (prog->intflags & PREGf_ANCH_SINGLE)
+                     || ( (prog->intflags & PREGf_ANCH_BOL)
                          && !multiline ) );    /* Check after \n? */
 
        if (!ml_anch) {
           /* we are only allowed to match at BOS or \G */
 
-         if (prog->extflags & RXf_ANCH_GPOS) {
+          if (prog->intflags & PREGf_ANCH_GPOS) {
             /* in this case, we hope(!) that the caller has already
              * set strpos to pos()-gofs, and will already have checked
              * that this anchor position is legal
@@ -1101,8 +1101,12 @@ Perl_re_intuit_start(pTHX_
            s = strpos;
            /* XXXX If the check string was an implicit check MBOL, then we need to unset the relevant flag
                    see http://bugs.activestate.com/show_bug.cgi?id=87173 */
-           if (prog->intflags & PREGf_IMPLICIT)
-               prog->extflags &= ~RXf_ANCH_MBOL;
+            if (prog->intflags & PREGf_IMPLICIT) {
+                prog->intflags &= ~PREGf_ANCH_MBOL;
+                /* maybe we have no anchors left after this... */
+                if (!(prog->intflags & PREGf_ANCH))
+                    prog->extflags &= ~RXf_IS_ANCHORED;
+            }
            /* XXXX This is a remnant of the old implementation.  It
                    looks wasteful, since now INTUIT can use many
                    other heuristics. */
@@ -1162,7 +1166,7 @@ Perl_re_intuit_start(pTHX_
            }
            DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
                                   "This position contradicts STCLASS...\n") );
-           if ((prog->extflags & RXf_ANCH) && !ml_anch)
+            if ((prog->intflags & PREGf_ANCH) && !ml_anch)
                goto fail;
            checked_upto = HOPBACKc(endpos, start_shift);
            DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %"IVdf" endpos: %"IVdf" checked_upto: %"IVdf"\n",
@@ -2304,7 +2308,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
          * to the start of the string, e.g. /w+\G/
          */
 
-        if (prog->extflags & RXf_ANCH_GPOS) {
+        if (prog->intflags & PREGf_ANCH_GPOS) {
             startpos  = reginfo->ganch - prog->gofs;
             if (startpos <
                 ((flags & REXEC_FAIL_ON_UNDERFLOW) ? stringarg : strbeg))
@@ -2495,11 +2499,10 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
 
     /* Simplest case:  anchored match need be tried only once. */
     /*  [unless only anchor is BOL and multiline is set] */
-    if (prog->extflags & (RXf_ANCH & ~RXf_ANCH_GPOS)) {
+    if (prog->intflags & (PREGf_ANCH & ~PREGf_ANCH_GPOS)) {
        if (s == startpos && regtry(reginfo, &s))
            goto got_it;
-       else if (multiline || (prog->intflags & PREGf_IMPLICIT)
-                || (prog->extflags & RXf_ANCH_MBOL)) /* XXXX SBOL? */
+        else if (multiline || (prog->intflags & (PREGf_IMPLICIT | PREGf_ANCH_MBOL))) /* XXXX SBOL? */
        {
            char *end;
 
@@ -2573,9 +2576,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend,
            } /* end search for newline */
        } /* end anchored/multiline check string search */
        goto phooey;
-    } else if ((prog->intflags & PREGf_GPOS_SEEN) && (prog->extflags & RXf_ANCH_GPOS))
+    } else if ((prog->intflags & (PREGf_GPOS_SEEN | PREGf_ANCH_GPOS)) == (PREGf_GPOS_SEEN | PREGf_ANCH_GPOS))
     {
-        /* XXX: Why do we check both PREGf_GPOS_SEEN && RXf_ANCH_GPOS the
+        /* XXX: Why do we check both PREGf_GPOS_SEEN && PREGf_ANCH_GPOS the
          * latter can't be true unless the former is too as far as I know.
          * Needs further investigation - Yves */
         /* For anchored \G, the only position it can match from is
index 1368a8a..a26c4f2 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -384,16 +384,13 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
     }
 }
 
-/* Anchor and GPOS related stuff */
-#define RXf_ANCH_BOL           (1<<(RXf_BASE_SHIFT+0))
-#define RXf_ANCH_MBOL          (1<<(RXf_BASE_SHIFT+1))
-#define RXf_ANCH_SBOL          (1<<(RXf_BASE_SHIFT+2))
-#define RXf_ANCH_GPOS          (1<<(RXf_BASE_SHIFT+3))
+/* Do we have some sort of anchor? */
+#define RXf_IS_ANCHORED         (1<<(RXf_BASE_SHIFT+0))
+#define RXf_UNUSED1             (1<<(RXf_BASE_SHIFT+1))
+#define RXf_UNUSED2             (1<<(RXf_BASE_SHIFT+2))
+#define RXf_UNUSED3             (1<<(RXf_BASE_SHIFT+3))
 #define RXf_UNUSED4             (1<<(RXf_BASE_SHIFT+4))
 #define RXf_UNUSED5             (1<<(RXf_BASE_SHIFT+5))
-/* two bits here */
-#define RXf_ANCH               (RXf_ANCH_BOL|RXf_ANCH_MBOL|RXf_ANCH_GPOS|RXf_ANCH_SBOL)
-#define RXf_ANCH_SINGLE         (RXf_ANCH_SBOL|RXf_ANCH_GPOS)
 
 /* What we have seen */
 #define RXf_NO_INPLACE_SUBST    (1<<(RXf_BASE_SHIFT+6))
index 9e17e88..088e5a6 100644 (file)
@@ -650,16 +650,16 @@ EXTCONST char * const PL_reg_extflags_name[] = {
        "CHARSET1",         /* 0x00000040 : "CHARSET" - 0x000000e0 */
        "CHARSET2",         /* 0x00000080 : "CHARSET" - 0x000000e0 */
        "SPLIT",            /* 0x00000100 */
-       "ANCH_BOL",         /* 0x00000200 */
-       "ANCH_MBOL",        /* 0x00000400 */
-       "ANCH_SBOL",        /* 0x00000800 */
-       "ANCH_GPOS",        /* 0x00001000 */
-       "UNUSED1",          /* 0x00002000 */
-       "UNUSED2",          /* 0x00004000 */
+       "IS_ANCHORED",      /* 0x00000200 */
+       "UNUSED1",          /* 0x00000400 */
+       "UNUSED2",          /* 0x00000800 */
+       "UNUSED3",          /* 0x00001000 */
+       "UNUSED4",          /* 0x00002000 */
+       "UNUSED5",          /* 0x00004000 */
        "NO_INPLACE_SUBST", /* 0x00008000 */
        "EVAL_SEEN",        /* 0x00010000 */
-       "UNUSED3",          /* 0x00020000 */
-       "UNUSED4",          /* 0x00040000 */
+       "UNUSED8",          /* 0x00020000 */
+       "UNUSED9",          /* 0x00040000 */
        "CHECK_ALL",        /* 0x00080000 */
        "MATCH_UTF8",       /* 0x00100000 */
        "USE_INTUIT_NOML",  /* 0x00200000 */
@@ -692,6 +692,10 @@ EXTCONST char * const PL_reg_intflags_name[] = {
        "CANY_SEEN",                  /* 0x00000080 - PREGf_CANY_SEEN */
        "GPOS_SEEN",                  /* 0x00000100 - PREGf_GPOS_SEEN */
        "GPOS_FLOAT",                 /* 0x00000200 - PREGf_GPOS_FLOAT */
+       "ANCH_BOL",                   /* 0x00000400 - PREGf_ANCH_BOL */
+       "ANCH_MBOL",                  /* 0x00000800 - PREGf_ANCH_MBOL */
+       "ANCH_SBOL",                  /* 0x00001000 - PREGf_ANCH_SBOL */
+       "ANCH_GPOS",                  /* 0x00002000 - PREGf_ANCH_GPOS */
 };
 #endif /* DOINIT */