* it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
* This causes the main functions to be compiled under new names and with
* debugging support added, which makes "use re 'debug'" work.
-
*/
/* NOTE: this is derived from Henry Spencer's regexp code, and should not
#define RF_tainted 1 /* tainted information used? */
#define RF_warned 2 /* warned about big count? */
#define RF_evaled 4 /* Did an EVAL with setting? */
-#define RF_utf8 8 /* String contains multibyte chars? */
+#define RF_utf8 8 /* Pattern contains multibyte chars? */
#define UTF ((PL_reg_flags & RF_utf8) != 0)
: (U8*)(pos + off))
#define HOPBACKc(pos, off) \
(char*)(PL_reg_match_utf8\
- ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
- : (pos - off >= PL_bostr) \
- ? pos - off \
+ ? reghopmaybe3((U8*)pos, -off, (U8*)PL_bostr) \
+ : (pos - off >= PL_bostr) \
+ ? (U8*)pos - off \
: NULL)
-#define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
+#define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)(pos), off, (U8*)(lim)) : (U8*)(pos + off))
#define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
#define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
#define REGCP_PAREN_ELEMS 4
const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
int p;
+ GET_RE_DEBUG_FLAGS_DECL;
if (paren_elems_to_push < 0)
Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
SSPUSHINT(PL_regstartp[p]);
SSPUSHPTR(PL_reg_start_tmp[p]);
SSPUSHINT(p);
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
+ " saving \\%"UVuf" %"IVdf"(%"IVdf")..%"IVdf"\n",
+ (UV)p, (IV)PL_regstartp[p],
+ (IV)(PL_reg_start_tmp[p] - PL_bostr),
+ (IV)PL_regendp[p]
+ ));
}
/* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
SSPUSHINT(PL_regsize);
}
/* These are needed since we do not localize EVAL nodes: */
-# define REGCP_SET(cp) DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, \
- " Setting an EVAL scope, savestack=%"IVdf"\n", \
- (IV)PL_savestack_ix)); cp = PL_savestack_ix
-
-# define REGCP_UNWIND(cp) DEBUG_EXECUTE_r(cp != PL_savestack_ix ? \
- PerlIO_printf(Perl_debug_log, \
- " Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
- (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
+#define REGCP_SET(cp) \
+ DEBUG_STATE_r( \
+ PerlIO_printf(Perl_debug_log, \
+ " Setting an EVAL scope, savestack=%"IVdf"\n", \
+ (IV)PL_savestack_ix)); \
+ cp = PL_savestack_ix
+
+#define REGCP_UNWIND(cp) \
+ DEBUG_STATE_r( \
+ if (cp != PL_savestack_ix) \
+ PerlIO_printf(Perl_debug_log, \
+ " Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
+ (IV)(cp), (IV)PL_savestack_ix)); \
+ regcpblow(cp)
STATIC char *
S_regcppop(pTHX_ const regexp *rex)
#define regcpblow(cp) LEAVE_SCOPE(cp) /* Ignores regcppush()ed data. */
-#define TRYPAREN(paren, n, input, where) { \
- if (paren) { \
- if (n) { \
- PL_regstartp[paren] = HOPc(input, -1) - PL_bostr; \
- PL_regendp[paren] = input - PL_bostr; \
- } \
- else \
- PL_regendp[paren] = -1; \
- } \
- REGMATCH(next, where); \
- if (result) \
- sayYES; \
- if (paren && n) \
- PL_regendp[paren] = -1; \
-}
-
-
/*
* pregexec and friends
*/
register SV *check;
char *strbeg;
char *t;
- const int do_utf8 = sv ? SvUTF8(sv) : 0; /* if no sv we have to assume bytes */
+ const bool do_utf8 = (sv && SvUTF8(sv)) ? 1 : 0; /* if no sv we have to assume bytes */
I32 ml_anch;
register char *other_last = NULL; /* other substr checked before this */
char *check_at = NULL; /* check substr found at this pos */
const I32 multiline = prog->reganch & PMf_MULTILINE;
#ifdef DEBUGGING
const char * const i_strpos = strpos;
- SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
#endif
GET_RE_DEBUG_FLAGS_DECL;
RX_MATCH_UTF8_set(prog,do_utf8);
if (prog->reganch & ROPT_UTF8) {
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- "UTF-8 regex...\n"));
PL_reg_flags |= RF_utf8;
}
-
- DEBUG_EXECUTE_r({
- const char *s = PL_reg_match_utf8 ?
- sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
- strpos;
- const int len = PL_reg_match_utf8 ?
- (int)strlen(s) : strend - strpos;
- if (!PL_colorset)
- reginitcolors();
- if (PL_reg_match_utf8)
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- "UTF-8 target...\n"));
- PerlIO_printf(Perl_debug_log,
- "%sGuessing start of match, REx%s \"%s%.60s%s%s\" against \"%s%.*s%s%s\"...\n",
- PL_colors[4], PL_colors[5], PL_colors[0],
- prog->precomp,
- PL_colors[1],
- (strlen(prog->precomp) > 60 ? "..." : ""),
- PL_colors[0],
- (int)(len > 60 ? 60 : len),
- s, PL_colors[1],
- (len > 60 ? "..." : "")
+ DEBUG_EXECUTE_r(
+ debug_start_match(prog, do_utf8, strpos, strend,
+ sv ? "Guessing start of match in sv for"
+ : "Guessing start of match in string for");
);
- });
/* CHR_DIST() would be more correct here but it makes things slow. */
if (prog->minlen > strend - strpos) {
"String too short... [re_intuit_start]\n"));
goto fail;
}
+
strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
PL_regeol = strend;
if (do_utf8) {
to_byte_substr(prog);
check = prog->check_substr;
}
- if (check == &PL_sv_undef) {
+ if (check == &PL_sv_undef) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- "Non-utf string cannot match utf check string\n"));
+ "Non-utf8 string cannot match utf8 check string\n"));
goto fail;
}
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
I32 slen;
s = HOP3c(strpos, prog->check_offset_min, strend);
+
if (SvTAIL(check)) {
slen = SvCUR(check); /* >= 1 */
/* Match is anchored, but substr is not anchored wrt beg-of-str. */
s = strpos;
start_shift = prog->check_offset_min; /* okay to underestimate on CC */
- end_shift = prog->minlen - start_shift -
- CHR_SVLEN(check) + (SvTAIL(check) != 0);
+ end_shift = prog->check_end_shift;
+
if (!ml_anch) {
const I32 end = prog->check_offset_max + CHR_SVLEN(check)
- (SvTAIL(check) != 0);
else { /* Can match at random position */
ml_anch = 0;
s = strpos;
- start_shift = prog->check_offset_min; /* okay to underestimate on CC */
- /* Should be nonnegative! */
- end_shift = prog->minlen - start_shift -
- CHR_SVLEN(check) + (SvTAIL(check) != 0);
+ start_shift = prog->check_offset_min; /* okay to underestimate on CC */
+ end_shift = prog->check_end_shift;
+
+ /* end shift should be non negative here */
}
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
if (end_shift < 0)
- Perl_croak(aTHX_ "panic: end_shift");
+ Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
+ end_shift,prog->precomp);
#endif
restart:
/* Find a possible match in the region s..strend by looking for
the "check" substring in the region corrected by start/end_shift. */
+
+ {
+ I32 srch_start_shift = start_shift;
+ I32 srch_end_shift = end_shift;
+ if (srch_start_shift < 0 && strbeg - s > srch_start_shift) {
+ srch_end_shift -= ((strbeg - s) - srch_start_shift);
+ srch_start_shift = strbeg - s;
+ }
+ DEBUG_OPTIMISE_r({
+ PerlIO_printf(Perl_debug_log, "Check offset min: %"IVdf" Start shift: %"IVdf" End shift %"IVdf" Real End Shift: %"IVdf"\n",
+ (IV)prog->check_offset_min,
+ (IV)srch_start_shift,
+ (IV)srch_end_shift,
+ (IV)prog->check_end_shift);
+ });
+
if (flags & REXEC_SCREAM) {
I32 p = -1; /* Internal iterator of scream. */
I32 * const pp = data ? data->scream_pos : &p;
&& (BmPREVIOUS(check) == SvCUR(check) - 1)
&& SvTAIL(check) ))
s = screaminstr(sv, check,
- start_shift + (s - strbeg), end_shift, pp, 0);
+ srch_start_shift + (s - strbeg), srch_end_shift, pp, 0);
else
goto fail_finish;
/* we may be pointing at the wrong string */
if (data)
*data->scream_olds = s;
}
- else if (prog->reganch & ROPT_CANY_SEEN)
- s = fbm_instr((U8*)(s + start_shift),
- (U8*)(strend - end_shift),
- check, multiline ? FBMrf_MULTILINE : 0);
- else
- s = fbm_instr(HOP3(s, start_shift, strend),
- HOP3(strend, -end_shift, strbeg),
+ else {
+ U8* start_point;
+ U8* end_point;
+ if (prog->reganch & ROPT_CANY_SEEN) {
+ start_point= (U8*)(s + srch_start_shift);
+ end_point= (U8*)(strend - srch_end_shift);
+ } else {
+ start_point= HOP3(s, srch_start_shift, srch_start_shift < 0 ? strbeg : strend);
+ end_point= HOP3(strend, -srch_end_shift, strbeg);
+ }
+ DEBUG_OPTIMISE_r({
+ PerlIO_printf(Perl_debug_log, "fbm_instr len=%d str=<%.*s>\n",
+ (int)(end_point - start_point),
+ (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point),
+ start_point);
+ });
+
+ s = fbm_instr( start_point, end_point,
check, multiline ? FBMrf_MULTILINE : 0);
-
+ }
+ }
/* Update the count-of-usability, remove useless subpatterns,
unshift s. */
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s %s substr \"%s%.*s%s\"%s%s",
+ DEBUG_EXECUTE_r({
+ RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
+ SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
+ PerlIO_printf(Perl_debug_log, "%s %s substr %s%s%s",
(s ? "Found" : "Did not find"),
- (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"),
- PL_colors[0],
- (int)(SvCUR(check) - (SvTAIL(check)!=0)),
- SvPVX_const(check),
- PL_colors[1], (SvTAIL(check) ? "$" : ""),
- (s ? " at offset " : "...\n") ) );
+ (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)
+ ? "anchored" : "floating"),
+ quoted,
+ RE_SV_TAIL(check),
+ (s ? " at offset " : "...\n") );
+ });
if (!s)
goto fail_finish;
-
- check_at = s;
-
/* Finish the diagnostic message */
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
+ /* XXX dmq: first branch is for positive lookbehind...
+ Our check string is offset from the beginning of the pattern.
+ So we need to do any stclass tests offset forward from that
+ point. I think. :-(
+ */
+
+
+
+ check_at=s;
+
+
/* Got a candidate. Check MBOL anchoring, and the *other* substr.
Start with the other substr.
XXXX no SCREAM optimization yet - and a very coarse implementation
Probably it is right to do no SCREAM here...
*/
- if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8) : (prog->float_substr && prog->anchored_substr)) {
+ if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8)
+ : (prog->float_substr && prog->anchored_substr))
+ {
/* Take into account the "other" substring. */
/* XXXX May be hopelessly wrong for UTF... */
if (!other_last)
{
char * const last = HOP3c(s, -start_shift, strbeg);
char *last1, *last2;
- char *s1 = s;
+ char * const saved_s = s;
SV* must;
t = s - prog->check_offset_max;
last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
if (last < last1)
last1 = last;
- /* XXXX It is not documented what units *_offsets are in. Assume bytes. */
+ /* XXXX It is not documented what units *_offsets are in.
+ We assume bytes, but this is clearly wrong.
+ Meaning this code needs to be carefully reviewed for errors.
+ dmq.
+ */
+
/* On end-of-str: see comment below. */
must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
if (must == &PL_sv_undef) {
s = (char*)NULL;
- DEBUG_EXECUTE_r(must = prog->anchored_utf8); /* for debug */
+ DEBUG_r(must = prog->anchored_utf8); /* for debug */
}
else
s = fbm_instr(
must,
multiline ? FBMrf_MULTILINE : 0
);
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
- "%s anchored substr \"%s%.*s%s\"%s",
+ DEBUG_EXECUTE_r({
+ RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
+ SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
+ PerlIO_printf(Perl_debug_log, "%s anchored substr %s%s",
(s ? "Found" : "Contradicts"),
- PL_colors[0],
- (int)(SvCUR(must)
- - (SvTAIL(must)!=0)),
- SvPVX_const(must),
- PL_colors[1], (SvTAIL(must) ? "$" : "")));
+ quoted, RE_SV_TAIL(must));
+ });
+
+
if (!s) {
if (last1 >= last2) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
}
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
", trying floating at offset %ld...\n",
- (long)(HOP3c(s1, 1, strend) - i_strpos)));
+ (long)(HOP3c(saved_s, 1, strend) - i_strpos)));
other_last = HOP3c(last1, prog->anchored_offset+1, strend);
s = HOP3c(last, 1, strend);
goto restart;
(long)(s - i_strpos)));
t = HOP3c(s, -prog->anchored_offset, strbeg);
other_last = HOP3c(s, 1, strend);
- s = s1;
+ s = saved_s;
if (t == strpos)
goto try_at_start;
goto try_at_offset;
}
else { /* Take into account the floating substring. */
char *last, *last1;
- char *s1 = s;
+ char * const saved_s = s;
SV* must;
t = HOP3c(s, -start_shift, strbeg);
and end-of-str is not later than strend we are OK. */
if (must == &PL_sv_undef) {
s = (char*)NULL;
- DEBUG_EXECUTE_r(must = prog->float_utf8); /* for debug message */
+ DEBUG_r(must = prog->float_utf8); /* for debug message */
}
else
s = fbm_instr((unsigned char*)s,
(unsigned char*)last + SvCUR(must)
- (SvTAIL(must)!=0),
must, multiline ? FBMrf_MULTILINE : 0);
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
+ DEBUG_EXECUTE_r({
+ RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
+ SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
+ PerlIO_printf(Perl_debug_log, "%s floating substr %s%s",
(s ? "Found" : "Contradicts"),
- PL_colors[0],
- (int)(SvCUR(must) - (SvTAIL(must)!=0)),
- SvPVX_const(must),
- PL_colors[1], (SvTAIL(must) ? "$" : "")));
+ quoted, RE_SV_TAIL(must));
+ });
if (!s) {
if (last1 == last) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
}
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
", trying anchored starting at offset %ld...\n",
- (long)(s1 + 1 - i_strpos)));
+ (long)(saved_s + 1 - i_strpos)));
other_last = last;
s = HOP3c(t, 1, strend);
goto restart;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
(long)(s - i_strpos)));
other_last = s; /* Fix this later. --Hugo */
- s = s1;
+ s = saved_s;
if (t == strpos)
goto try_at_start;
goto try_at_offset;
}
}
- t = s - prog->check_offset_max;
+
+ t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
+
+ DEBUG_OPTIMISE_r(
+ PerlIO_printf(Perl_debug_log,
+ "Check offset min:%"IVdf" max:%"IVdf" S:%"IVdf" t:%"IVdf" D:%"IVdf" end:%"IVdf"\n",
+ (IV)prog->check_offset_min,
+ (IV)prog->check_offset_max,
+ (IV)(s-strpos),
+ (IV)(t-strpos),
+ (IV)(t-s),
+ (IV)(strend-strpos)
+ )
+ );
+
if (s - strpos > prog->check_offset_max /* signed-corrected t > strpos */
&& (!do_utf8
- || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*)strpos))
- && t > strpos))) {
+ || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (U8*) ((prog->check_offset_max<0) ? strend : strpos)))
+ && t > strpos)))
+ {
/* Fixed substring is found far enough so that the match
cannot start at strpos. */
try_at_offset:
/* Last resort... */
/* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
- if (prog->regstclass) {
+ /* trie stclasses are too expensive to use here, we are better off to
+ leave it to regmatch itself */
+ if (prog->regstclass && PL_regkind[OP(prog->regstclass)]!=TRIE) {
/* minlen == 0 is possible if regstclass is \b or \B,
and the fixed substr is ''$.
Since minlen is already taken into account, s+1 is before strend;
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)
- ? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
- : (prog->float_substr || prog->float_utf8
- ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
- cl_l, strend)
- : strend);
-
+ char * endpos;
+ if (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
+ endpos= HOP3c(s, (prog->minlen ? cl_l : 0), strend);
+ else if (prog->float_substr || prog->float_utf8)
+ endpos= HOP3c(HOP3c(check_at, -start_shift, strbeg), cl_l, strend);
+ else
+ endpos= strend;
+
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "start_shift: %"IVdf" check_at: %d s: %d endpos: %d\n",
+ start_shift,check_at-strbeg,s-strbeg,endpos-strbeg));
+
t = s;
s = find_byclass(prog, prog->regstclass, s, endpos, NULL);
if (!s) {
return NULL;
}
+
+
+#define REXEC_TRIE_READ_CHAR(trie_type, trie, uc, uscan, len, uvc, charid, \
+foldlen, foldbuf, uniflags) STMT_START { \
+ switch (trie_type) { \
+ case trie_utf8_fold: \
+ if ( foldlen>0 ) { \
+ uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
+ foldlen -= len; \
+ uscan += len; \
+ len=0; \
+ } else { \
+ uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
+ uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
+ foldlen -= UNISKIP( uvc ); \
+ uscan = foldbuf + UNISKIP( uvc ); \
+ } \
+ break; \
+ case trie_utf8: \
+ uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
+ break; \
+ case trie_plain: \
+ uvc = (UV)*uc; \
+ len = 1; \
+ } \
+ \
+ if (uvc < 256) { \
+ charid = trie->charmap[ uvc ]; \
+ } \
+ else { \
+ charid = 0; \
+ if (trie->widecharmap) { \
+ SV** const svpp = hv_fetch(trie->widecharmap, \
+ (char*)&uvc, sizeof(UV), 0); \
+ if (svpp) \
+ charid = (U16)SvIV(*svpp); \
+ } \
+ } \
+} STMT_END
+
+#define REXEC_FBC_EXACTISH_CHECK(CoNd) \
+ if ( (CoNd) \
+ && (ln == len || \
+ ibcmp_utf8(s, NULL, 0, do_utf8, \
+ m, NULL, ln, (bool)UTF)) \
+ && (!reginfo || regtry(reginfo, s)) ) \
+ goto got_it; \
+ else { \
+ U8 foldbuf[UTF8_MAXBYTES_CASE+1]; \
+ uvchr_to_utf8(tmpbuf, c); \
+ f = to_utf8_fold(tmpbuf, foldbuf, &foldlen); \
+ if ( f != c \
+ && (f == c1 || f == c2) \
+ && (ln == foldlen || \
+ !ibcmp_utf8((char *) foldbuf, \
+ NULL, foldlen, do_utf8, \
+ m, \
+ NULL, ln, (bool)UTF)) \
+ && (!reginfo || regtry(reginfo, s)) ) \
+ goto got_it; \
+ } \
+ s += len
+
+#define REXEC_FBC_EXACTISH_SCAN(CoNd) \
+STMT_START { \
+ while (s <= e) { \
+ if ( (CoNd) \
+ && (ln == 1 || !(OP(c) == EXACTF \
+ ? ibcmp(s, m, ln) \
+ : ibcmp_locale(s, m, ln))) \
+ && (!reginfo || regtry(reginfo, s)) ) \
+ goto got_it; \
+ s++; \
+ } \
+} STMT_END
+
+#define REXEC_FBC_UTF8_SCAN(CoDe) \
+STMT_START { \
+ while (s + (uskip = UTF8SKIP(s)) <= strend) { \
+ CoDe \
+ s += uskip; \
+ } \
+} STMT_END
+
+#define REXEC_FBC_SCAN(CoDe) \
+STMT_START { \
+ while (s < strend) { \
+ CoDe \
+ s++; \
+ } \
+} STMT_END
+
+#define REXEC_FBC_UTF8_CLASS_SCAN(CoNd) \
+REXEC_FBC_UTF8_SCAN( \
+ if (CoNd) { \
+ if (tmp && (!reginfo || regtry(reginfo, s))) \
+ goto got_it; \
+ else \
+ tmp = doevery; \
+ } \
+ else \
+ tmp = 1; \
+)
+
+#define REXEC_FBC_CLASS_SCAN(CoNd) \
+REXEC_FBC_SCAN( \
+ if (CoNd) { \
+ if (tmp && (!reginfo || regtry(reginfo, s))) \
+ goto got_it; \
+ else \
+ tmp = doevery; \
+ } \
+ else \
+ tmp = 1; \
+)
+
+#define REXEC_FBC_TRYIT \
+if ((!reginfo || regtry(reginfo, s))) \
+ goto got_it
+
+#define REXEC_FBC_CSCAN_PRELOAD(UtFpReLoAd,CoNdUtF8,CoNd) \
+ if (do_utf8) { \
+ UtFpReLoAd; \
+ REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \
+ } \
+ else { \
+ REXEC_FBC_CLASS_SCAN(CoNd); \
+ } \
+ break
+
+#define REXEC_FBC_CSCAN_TAINT(CoNdUtF8,CoNd) \
+ PL_reg_flags |= RF_tainted; \
+ if (do_utf8) { \
+ REXEC_FBC_UTF8_CLASS_SCAN(CoNdUtF8); \
+ } \
+ else { \
+ REXEC_FBC_CLASS_SCAN(CoNd); \
+ } \
+ break
+
+#define DUMP_EXEC_POS(li,s,doutf8) \
+ dump_exec_pos(li,s,(PL_regeol),(PL_bostr),(PL_reg_starttry),doutf8)
+
/* We know what class REx starts with. Try to find this position... */
/* if reginfo is NULL, its a dryrun */
+/* annoyingly all the vars in this routine have different names from their counterparts
+ in regmatch. /grrr */
STATIC char *
-S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char
-*strend, const regmatch_info *reginfo)
+S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
+ const char *strend, const regmatch_info *reginfo)
{
dVAR;
const I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
switch (OP(c)) {
case ANYOF:
if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
+ REXEC_FBC_UTF8_CLASS_SCAN((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
!UTF8_IS_INVARIANT((U8)s[0]) ?
reginclass(prog, c, (U8*)s, 0, do_utf8) :
- REGINCLASS(prog, c, (U8*)s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
+ REGINCLASS(prog, c, (U8*)s));
}
else {
while (s < strend) {
}
break;
case CANY:
- while (s < strend) {
+ REXEC_FBC_SCAN(
if (tmp && (!reginfo || regtry(reginfo, s)))
goto got_it;
else
tmp = doevery;
- s++;
- }
+ );
break;
case EXACTF:
m = STRING(c);
while (s <= e) {
c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
uniflags);
- if ( c == c1
- && (ln == len ||
- ibcmp_utf8(s, NULL, 0, do_utf8,
- m, NULL, ln, (bool)UTF))
- && (!reginfo || regtry(reginfo, s)) )
- goto got_it;
- else {
- U8 foldbuf[UTF8_MAXBYTES_CASE+1];
- uvchr_to_utf8(tmpbuf, c);
- f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
- if ( f != c
- && (f == c1 || f == c2)
- && (ln == foldlen ||
- !ibcmp_utf8((char *) foldbuf,
- NULL, foldlen, do_utf8,
- m,
- NULL, ln, (bool)UTF))
- && (!reginfo || regtry(reginfo, s)) )
- goto got_it;
- }
- s += len;
+ REXEC_FBC_EXACTISH_CHECK(c == c1);
}
}
else {
c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
- if ( (c == c1 || c == c2)
- && (ln == len ||
- ibcmp_utf8(s, NULL, 0, do_utf8,
- m, NULL, ln, (bool)UTF))
- && (!reginfo || regtry(reginfo, s)) )
- goto got_it;
- else {
- U8 foldbuf[UTF8_MAXBYTES_CASE+1];
- uvchr_to_utf8(tmpbuf, c);
- f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
- if ( f != c
- && (f == c1 || f == c2)
- && (ln == foldlen ||
- !ibcmp_utf8((char *) foldbuf,
- NULL, foldlen, do_utf8,
- m,
- NULL, ln, (bool)UTF))
- && (!reginfo || regtry(reginfo, s)) )
- goto got_it;
- }
- s += len;
+ REXEC_FBC_EXACTISH_CHECK(c == c1 || c == c2);
}
}
}
else {
if (c1 == c2)
- while (s <= e) {
- if ( *(U8*)s == c1
- && (ln == 1 || !(OP(c) == EXACTF
- ? ibcmp(s, m, ln)
- : ibcmp_locale(s, m, ln)))
- && (!reginfo || regtry(reginfo, s)) )
- goto got_it;
- s++;
- }
+ REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1);
else
- while (s <= e) {
- if ( (*(U8*)s == c1 || *(U8*)s == c2)
- && (ln == 1 || !(OP(c) == EXACTF
- ? ibcmp(s, m, ln)
- : ibcmp_locale(s, m, ln)))
- && (!reginfo || regtry(reginfo, s)) )
- goto got_it;
- s++;
- }
+ REXEC_FBC_EXACTISH_SCAN(*(U8*)s == c1 || *(U8*)s == c2);
}
break;
case BOUNDL:
tmp = ((OP(c) == BOUND ?
isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
LOAD_UTF8_CHARCLASS_ALNUM();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
+ REXEC_FBC_UTF8_SCAN(
if (tmp == !(OP(c) == BOUND ?
(bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
isALNUM_LC_utf8((U8*)s)))
{
tmp = !tmp;
- if ((!reginfo || regtry(reginfo, s)))
- goto got_it;
- }
- s += uskip;
+ REXEC_FBC_TRYIT;
}
+ );
}
else {
tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
- while (s < strend) {
+ REXEC_FBC_SCAN(
if (tmp ==
!(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
tmp = !tmp;
- if ((!reginfo || regtry(reginfo, s)))
- goto got_it;
- }
- s++;
+ REXEC_FBC_TRYIT;
}
+ );
}
if ((!prog->minlen && tmp) && (!reginfo || regtry(reginfo, s)))
goto got_it;
tmp = ((OP(c) == NBOUND ?
isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
LOAD_UTF8_CHARCLASS_ALNUM();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
+ REXEC_FBC_UTF8_SCAN(
if (tmp == !(OP(c) == NBOUND ?
(bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
isALNUM_LC_utf8((U8*)s)))
tmp = !tmp;
- else if ((!reginfo || regtry(reginfo, s)))
- goto got_it;
- s += uskip;
- }
+ else REXEC_FBC_TRYIT;
+ );
}
else {
tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
tmp = ((OP(c) == NBOUND ?
isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
- while (s < strend) {
+ REXEC_FBC_SCAN(
if (tmp ==
!(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
tmp = !tmp;
- else if ((!reginfo || regtry(reginfo, s)))
- goto got_it;
- s++;
- }
+ else REXEC_FBC_TRYIT;
+ );
}
if ((!prog->minlen && !tmp) && (!reginfo || regtry(reginfo, s)))
goto got_it;
break;
case ALNUM:
- if (do_utf8) {
- LOAD_UTF8_CHARCLASS_ALNUM();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (isALNUM(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_PRELOAD(
+ LOAD_UTF8_CHARCLASS_ALNUM(),
+ swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
+ isALNUM(*s)
+ );
case ALNUML:
- PL_reg_flags |= RF_tainted;
- if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (isALNUM_LC_utf8((U8*)s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (isALNUM_LC(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_TAINT(
+ isALNUM_LC_utf8((U8*)s),
+ isALNUM_LC(*s)
+ );
case NALNUM:
- if (do_utf8) {
- LOAD_UTF8_CHARCLASS_ALNUM();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (!isALNUM(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_PRELOAD(
+ LOAD_UTF8_CHARCLASS_ALNUM(),
+ !swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8),
+ !isALNUM(*s)
+ );
case NALNUML:
- PL_reg_flags |= RF_tainted;
- if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (!isALNUM_LC_utf8((U8*)s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (!isALNUM_LC(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_TAINT(
+ !isALNUM_LC_utf8((U8*)s),
+ !isALNUM_LC(*s)
+ );
case SPACE:
- if (do_utf8) {
- LOAD_UTF8_CHARCLASS_SPACE();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (isSPACE(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_PRELOAD(
+ LOAD_UTF8_CHARCLASS_SPACE(),
+ *s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8),
+ isSPACE(*s)
+ );
case SPACEL:
- PL_reg_flags |= RF_tainted;
- if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (isSPACE_LC(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_TAINT(
+ *s == ' ' || isSPACE_LC_utf8((U8*)s),
+ isSPACE_LC(*s)
+ );
case NSPACE:
- if (do_utf8) {
- LOAD_UTF8_CHARCLASS_SPACE();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (!isSPACE(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_PRELOAD(
+ LOAD_UTF8_CHARCLASS_SPACE(),
+ !(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)),
+ !isSPACE(*s)
+ );
case NSPACEL:
- PL_reg_flags |= RF_tainted;
- if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (!isSPACE_LC(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_TAINT(
+ !(*s == ' ' || isSPACE_LC_utf8((U8*)s)),
+ !isSPACE_LC(*s)
+ );
case DIGIT:
- if (do_utf8) {
- LOAD_UTF8_CHARCLASS_DIGIT();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (isDIGIT(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_PRELOAD(
+ LOAD_UTF8_CHARCLASS_DIGIT(),
+ swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
+ isDIGIT(*s)
+ );
case DIGITL:
- PL_reg_flags |= RF_tainted;
- if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (isDIGIT_LC_utf8((U8*)s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (isDIGIT_LC(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_TAINT(
+ isDIGIT_LC_utf8((U8*)s),
+ isDIGIT_LC(*s)
+ );
case NDIGIT:
- if (do_utf8) {
- LOAD_UTF8_CHARCLASS_DIGIT();
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (!isDIGIT(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
- }
- break;
+ REXEC_FBC_CSCAN_PRELOAD(
+ LOAD_UTF8_CHARCLASS_DIGIT(),
+ !swash_fetch(PL_utf8_digit,(U8*)s, do_utf8),
+ !isDIGIT(*s)
+ );
case NDIGITL:
- PL_reg_flags |= RF_tainted;
- if (do_utf8) {
- while (s + (uskip = UTF8SKIP(s)) <= strend) {
- if (!isDIGIT_LC_utf8((U8*)s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s += uskip;
- }
- }
- else {
- while (s < strend) {
- if (!isDIGIT_LC(*s)) {
- if (tmp && (!reginfo || regtry(reginfo, s)))
- goto got_it;
- else
- tmp = doevery;
- }
- else
- tmp = 1;
- s++;
- }
+ REXEC_FBC_CSCAN_TAINT(
+ !isDIGIT_LC_utf8((U8*)s),
+ !isDIGIT_LC(*s)
+ );
+ case AHOCORASICKC:
+ case AHOCORASICK:
+ {
+ const enum { trie_plain, trie_utf8, trie_utf8_fold }
+ trie_type = do_utf8 ?
+ (c->flags == EXACT ? trie_utf8 : trie_utf8_fold)
+ : trie_plain;
+ /* what trie are we using right now */
+ reg_ac_data *aho
+ = (reg_ac_data*)prog->data->data[ ARG( c ) ];
+ reg_trie_data *trie=aho->trie;
+
+ const char *last_start = strend - trie->minlen;
+#ifdef DEBUGGING
+ const char *real_start = s;
+#endif
+ STRLEN maxlen = trie->maxlen;
+ SV *sv_points;
+ U8 **points; /* map of where we were in the input string
+ when reading a given char. For ASCII this
+ is unnecessary overhead as the relationship
+ is always 1:1, but for unicode, especially
+ case folded unicode this is not true. */
+ U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+ U8 *bitmap=NULL;
+
+
+ GET_RE_DEBUG_FLAGS_DECL;
+
+ /* We can't just allocate points here. We need to wrap it in
+ * an SV so it gets freed properly if there is a croak while
+ * running the match */
+ ENTER;
+ SAVETMPS;
+ sv_points=newSV(maxlen * sizeof(U8 *));
+ SvCUR_set(sv_points,
+ maxlen * sizeof(U8 *));
+ SvPOK_on(sv_points);
+ sv_2mortal(sv_points);
+ points=(U8**)SvPV_nolen(sv_points );
+ if ( trie_type != trie_utf8_fold
+ && (trie->bitmap || OP(c)==AHOCORASICKC) )
+ {
+ if (trie->bitmap)
+ bitmap=(U8*)trie->bitmap;
+ else
+ bitmap=(U8*)ANYOF_BITMAP(c);
+ }
+ /* this is the Aho-Corasick algorithm modified a touch
+ to include special handling for long "unknown char"
+ sequences. The basic idea being that we use AC as long
+ as we are dealing with a possible matching char, when
+ we encounter an unknown char (and we have not encountered
+ an accepting state) we scan forward until we find a legal
+ starting char.
+ AC matching is basically that of trie matching, except
+ that when we encounter a failing transition, we fall back
+ to the current states "fail state", and try the current char
+ again, a process we repeat until we reach the root state,
+ state 1, or a legal transition. If we fail on the root state
+ then we can either terminate if we have reached an accepting
+ state previously, or restart the entire process from the beginning
+ if we have not.
+
+ */
+ while (s <= last_start) {
+ const U32 uniflags = UTF8_ALLOW_DEFAULT;
+ U8 *uc = (U8*)s;
+ U16 charid = 0;
+ U32 base = 1;
+ U32 state = 1;
+ UV uvc = 0;
+ STRLEN len = 0;
+ STRLEN foldlen = 0;
+ U8 *uscan = (U8*)NULL;
+ U8 *leftmost = NULL;
+#ifdef DEBUGGING
+ U32 accepted_word= 0;
+#endif
+ U32 pointpos = 0;
+
+ while ( state && uc <= (U8*)strend ) {
+ int failed=0;
+ U32 word = aho->states[ state ].wordnum;
+
+ if( state==1 ) {
+ if ( bitmap ) {
+ DEBUG_TRIE_EXECUTE_r(
+ if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ dump_exec_pos( (char *)uc, c, strend, real_start,
+ (char *)uc, do_utf8 );
+ PerlIO_printf( Perl_debug_log,
+ " Scanning for legal start char...\n");
+ }
+ );
+ while ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
+ uc++;
+ }
+ s= (char *)uc;
+ }
+ if (uc >(U8*)last_start) break;
+ }
+
+ if ( word ) {
+ U8 *lpos= points[ (pointpos - trie->wordlen[word-1] ) % maxlen ];
+ if (!leftmost || lpos < leftmost) {
+ DEBUG_r(accepted_word=word);
+ leftmost= lpos;
+ }
+ if (base==0) break;
+
+ }
+ points[pointpos++ % maxlen]= uc;
+ REXEC_TRIE_READ_CHAR(trie_type, trie, uc, uscan, len,
+ uvc, charid, foldlen, foldbuf, uniflags);
+ DEBUG_TRIE_EXECUTE_r({
+ dump_exec_pos( (char *)uc, c, strend, real_start,
+ s, do_utf8 );
+ PerlIO_printf(Perl_debug_log,
+ " Charid:%3u CP:%4"UVxf" ",
+ charid, uvc);
+ });
+
+ do {
+#ifdef DEBUGGING
+ word = aho->states[ state ].wordnum;
+#endif
+ base = aho->states[ state ].trans.base;
+
+ DEBUG_TRIE_EXECUTE_r({
+ if (failed)
+ dump_exec_pos( (char *)uc, c, strend, real_start,
+ s, do_utf8 );
+ PerlIO_printf( Perl_debug_log,
+ "%sState: %4"UVxf", word=%"UVxf,
+ failed ? " Fail transition to " : "",
+ (UV)state, (UV)word);
+ });
+ if ( base ) {
+ U32 tmp;
+ if (charid &&
+ (base + charid > trie->uniquecharcount )
+ && (base + charid - 1 - trie->uniquecharcount
+ < trie->lasttrans)
+ && trie->trans[base + charid - 1 -
+ trie->uniquecharcount].check == state
+ && (tmp=trie->trans[base + charid - 1 -
+ trie->uniquecharcount ].next))
+ {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log," - legal\n"));
+ state = tmp;
+ break;
+ }
+ else {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log," - fail\n"));
+ failed = 1;
+ state = aho->fail[state];
+ }
+ }
+ else {
+ /* we must be accepting here */
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log," - accepting\n"));
+ failed = 1;
+ break;
+ }
+ } while(state);
+ uc += len;
+ if (failed) {
+ if (leftmost)
+ break;
+ if (!state) state = 1;
+ }
+ }
+ if ( aho->states[ state ].wordnum ) {
+ U8 *lpos = points[ (pointpos - trie->wordlen[aho->states[ state ].wordnum-1]) % maxlen ];
+ if (!leftmost || lpos < leftmost) {
+ DEBUG_r(accepted_word=aho->states[ state ].wordnum);
+ leftmost = lpos;
+ }
+ }
+ if (leftmost) {
+ s = (char*)leftmost;
+ DEBUG_TRIE_EXECUTE_r({
+ PerlIO_printf(
+ Perl_debug_log,"Matches word #%"UVxf" at position %d. Trying full pattern...\n",
+ (UV)accepted_word, s - real_start
+ );
+ });
+ if (!reginfo || regtry(reginfo, s)) {
+ FREETMPS;
+ LEAVE;
+ goto got_it;
+ }
+ s = HOPc(s,1);
+ DEBUG_TRIE_EXECUTE_r({
+ PerlIO_printf( Perl_debug_log,"Pattern failed. Looking for new start point...\n");
+ });
+ } else {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log,"No match.\n"));
+ break;
+ }
+ }
+ FREETMPS;
+ LEAVE;
}
break;
default:
SV* const oreplsv = GvSV(PL_replgv);
const bool do_utf8 = DO_UTF8(sv);
I32 multiline;
-#ifdef DEBUGGING
- SV* dsv0;
- SV* dsv1;
-#endif
+
regmatch_info reginfo; /* create some info to pass to regtry etc */
GET_RE_DEBUG_FLAGS_DECL;
multiline = prog->reganch & PMf_MULTILINE;
reginfo.prog = prog;
-#ifdef DEBUGGING
- dsv0 = PERL_DEBUG_PAD_ZERO(0);
- dsv1 = PERL_DEBUG_PAD_ZERO(1);
-#endif
-
RX_MATCH_UTF8_set(prog, do_utf8);
+ DEBUG_EXECUTE_r(
+ debug_start_match(prog, do_utf8, startpos, strend,
+ "Matching");
+ );
minlen = prog->minlen;
- if (strend - startpos < minlen) {
+
+ if (strend - startpos < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
"String too short [regexec_flags]...\n"));
goto phooey;
}
+
/* Check validity of program. */
if (UCHARAT(prog->program) != REG_MAGIC) {
Perl_croak(aTHX_ "corrupted regexp program");
}
}
- DEBUG_EXECUTE_r({
- const char * const s0 = UTF
- ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
- UNI_DISPLAY_REGEX)
- : prog->precomp;
- const int len0 = UTF ? (int)SvCUR(dsv0) : prog->prelen;
- const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
- UNI_DISPLAY_REGEX) : startpos;
- const int len1 = do_utf8 ? (int)SvCUR(dsv1) : strend - startpos;
- if (!PL_colorset)
- reginitcolors();
- PerlIO_printf(Perl_debug_log,
- "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n",
- PL_colors[4], PL_colors[5], PL_colors[0],
- len0, len0, s0,
- PL_colors[1],
- len0 > 60 ? "..." : "",
- PL_colors[0],
- (int)(len1 > 60 ? 60 : len1),
- s1, PL_colors[1],
- (len1 > 60 ? "..." : "")
- );
- });
+
/* Simplest case: anchored match need be tried only once. */
/* [unless only anchor is BOL and multiline is set] */
ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
if (do_utf8) {
- while (s < strend) {
+ REXEC_FBC_SCAN(
if (*s == ch) {
DEBUG_EXECUTE_r( did_match = 1 );
if (regtry(®info, s)) goto got_it;
while (s < strend && *s == ch)
s += UTF8SKIP(s);
}
- s += UTF8SKIP(s);
- }
+ );
}
else {
- while (s < strend) {
+ REXEC_FBC_SCAN(
if (*s == ch) {
DEBUG_EXECUTE_r( did_match = 1 );
if (regtry(®info, s)) goto got_it;
while (s < strend && *s == ch)
s++;
}
- s++;
- }
+ );
}
DEBUG_EXECUTE_r(if (!did_match)
PerlIO_printf(Perl_debug_log,
back_max = prog->float_max_offset;
back_min = prog->float_min_offset;
}
+
+
if (must == &PL_sv_undef)
/* could not downgrade utf8 check substring, so must fail */
goto phooey;
- last = HOP3c(strend, /* Cannot start after this */
- -(I32)(CHR_SVLEN(must)
- - (SvTAIL(must) != 0) + back_min), strbeg);
-
+ if (back_min<0) {
+ last = strend;
+ } else {
+ last = HOP3c(strend, /* Cannot start after this */
+ -(I32)(CHR_SVLEN(must)
+ - (SvTAIL(must) != 0) + back_min), strbeg);
+ }
if (s > PL_bostr)
last1 = HOPc(s, -1);
else
strend = HOPc(strend, -dontbother);
while ( (s <= last) &&
((flags & REXEC_SCREAM)
- ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
+ ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
end_shift, &scream_pos, 0))
- : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
+ : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
(unsigned char*)strend, must,
multiline ? FBMrf_MULTILINE : 0))) ) {
/* we may be pointing at the wrong string */
}
}
}
- DEBUG_EXECUTE_r(if (!did_match)
- PerlIO_printf(Perl_debug_log,
- "Did not find %s substr \"%s%.*s%s\"%s...\n",
+ DEBUG_EXECUTE_r(if (!did_match) {
+ RE_PV_QUOTED_DECL(quoted, do_utf8, PERL_DEBUG_PAD_ZERO(0),
+ SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
+ PerlIO_printf(Perl_debug_log, "Did not find %s substr %s%s...\n",
((must == prog->anchored_substr || must == prog->anchored_utf8)
? "anchored" : "floating"),
- PL_colors[0],
- (int)(SvCUR(must) - (SvTAIL(must)!=0)),
- SvPVX_const(must),
- PL_colors[1], (SvTAIL(must) ? "$" : ""))
- );
+ quoted, RE_SV_TAIL(must));
+ });
goto phooey;
}
- else if ((c = prog->regstclass)) {
+ else if ( (c = prog->regstclass) ) {
if (minlen) {
- I32 op = OP(prog->regstclass);
+ const OPCODE op = OP(prog->regstclass);
/* don't bother with what can't match */
- if (PL_regkind[op] != EXACT && op != CANY)
+ if (PL_regkind[op] != EXACT && op != CANY && PL_regkind[op] != TRIE)
strend = HOPc(strend, -(minlen - 1));
}
DEBUG_EXECUTE_r({
- SV *prop = sv_newmortal();
- const char *s0;
- const char *s1;
- int len0;
- int len1;
-
+ SV * const prop = sv_newmortal();
regprop(prog, prop, c);
- s0 = UTF ?
- pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
- UNI_DISPLAY_REGEX) :
- SvPVX_const(prop);
- len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
- s1 = UTF ?
- sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
- len1 = UTF ? (int)SvCUR(dsv1) : strend - s;
- PerlIO_printf(Perl_debug_log,
- "Matching stclass \"%*.*s\" against \"%*.*s\"\n",
- len0, len0, s0,
- len1, len1, s1);
+ {
+ RE_PV_QUOTED_DECL(quoted,UTF,PERL_DEBUG_PAD_ZERO(1),
+ s,strend-s,60);
+ PerlIO_printf(Perl_debug_log,
+ "Matching stclass %.*s against %s (%d chars)\n",
+ (int)SvCUR(prop), SvPVX_const(prop),
+ quoted, (int)(strend - s));
+ }
});
if (find_byclass(prog, c, s, strend, ®info))
goto got_it;
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass... [regexec_flags]\n"));
}
else {
dontbother = 0;
if ( !(flags & REXEC_NOT_FIRST) ) {
RX_MATCH_COPY_FREE(prog);
if (flags & REXEC_COPY_STR) {
- I32 i = PL_regeol - startpos + (stringarg - strbeg);
+ const I32 i = PL_regeol - startpos + (stringarg - strbeg);
#ifdef PERL_OLD_COPY_ON_WRITE
if ((SvIsCOW(sv)
|| (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
Newxz(PL_reg_curpm, 1, PMOP);
#ifdef USE_ITHREADS
{
- SV* repointer = newSViv(0);
+ SV* const repointer = newSViv(0);
/* so we know which PL_regex_padav element is PL_reg_curpm */
SvFLAGS(repointer) |= SVf_BREAK;
av_push(PL_regex_padav,repointer);
return 0;
}
-#define RE_UNWIND_BRANCH 1
-#define RE_UNWIND_BRANCHJ 2
-
-union re_unwind_t;
-
-typedef struct { /* XX: makes sense to enlarge it... */
- I32 type;
- I32 prev;
- CHECKPOINT lastcp;
-} re_unwind_generic_t;
-
-typedef struct {
- I32 type;
- I32 prev;
- CHECKPOINT lastcp;
- I32 lastparen;
- regnode *next;
- char *locinput;
- I32 nextchr;
- int minmod;
-#ifdef DEBUGGING
- int regindent;
-#endif
-} re_unwind_branch_t;
-
-typedef union re_unwind_t {
- I32 type;
- re_unwind_generic_t generic;
- re_unwind_branch_t branch;
-} re_unwind_t;
#define sayYES goto yes
#define sayNO goto no
#define sayNO_SILENT goto do_no
#define saySAME(x) if (x) goto yes; else goto no
-#define POSCACHE_SUCCESS 0 /* caching success rather than failure */
-#define POSCACHE_SEEN 1 /* we know what we're caching */
-#define POSCACHE_START 2 /* the real cache: this bit maps to pos 0 */
-
-#define CACHEsayYES STMT_START { \
- if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) { \
- if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) { \
- PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) | (1<<POSCACHE_SEEN); \
- PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit); \
- } \
- else if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS)) { \
- PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit); \
- } \
- else { \
- /* cache records failure, but this is success */ \
- DEBUG_r( \
- PerlIO_printf(Perl_debug_log, \
- "%*s (remove success from failure cache)\n", \
- REPORT_CODE_OFF+PL_regindent*2, "") \
- ); \
- PL_reg_poscache[st->u.whilem.cache_offset] &= ~(1<<st->u.whilem.cache_bit); \
- } \
- } \
- sayYES; \
-} STMT_END
-
#define CACHEsayNO STMT_START { \
- if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) { \
- if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) { \
- PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
- PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit); \
- } \
- else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
- PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit); \
- } \
- else { \
- /* cache records success, but this is failure */ \
- DEBUG_r( \
- PerlIO_printf(Perl_debug_log, \
- "%*s (remove failure from success cache)\n", \
- REPORT_CODE_OFF+PL_regindent*2, "") \
- ); \
- PL_reg_poscache[st->u.whilem.cache_offset] &= ~(1<<st->u.whilem.cache_bit); \
- } \
- } \
+ if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) \
+ PL_reg_poscache[st->u.whilem.cache_offset] |= \
+ (1<<st->u.whilem.cache_bit); \
sayNO; \
} STMT_END
+
/* this is used to determine how far from the left messages like
'failed...' are printed. Currently 29 makes these messages line
up with the opcode they refer to. Earlier perls used 25 which
/* Make sure there is a test for this +1 options in re_tests */
#define TRIE_INITAL_ACCEPT_BUFFLEN 4;
-/* this value indiciates that the c1/c2 "next char" test should be skipped */
-#define CHRTEST_VOID -1000
+#define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */
+#define CHRTEST_VOID -1000 /* the c1/c2 "next char" test should be skipped */
#define SLAB_FIRST(s) (&(s)->states[0])
#define SLAB_LAST(s) (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1])
goto start_recurse; \
resume_point_##where:
+/* push a new state then goto it */
+
+#define PUSH_STATE_GOTO(state, node) \
+ scan = node; \
+ st->resume_state = state; \
+ goto push_state;
+
+/* push a new state with success backtracking, then goto it */
+
+#define PUSH_YES_STATE_GOTO(state, node) \
+ scan = node; \
+ st->resume_state = state; \
+ goto push_yes_state;
+
-/* push a new regex state. Set newst to point to it */
-
-#define PUSH_STATE(newst, resume) \
- depth++; \
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "PUSH STATE(%d)\n", depth)); \
- st->scan = scan; \
- st->next = next; \
- st->n = n; \
- st->locinput = locinput; \
- st->resume_state = resume; \
- newst = st+1; \
- if (newst > SLAB_LAST(PL_regmatch_slab)) \
- newst = S_push_slab(aTHX); \
- PL_regmatch_state = newst; \
- newst->cc = 0; \
- newst->minmod = 0; \
- newst->sw = 0; \
- newst->logical = 0; \
- newst->unwind = 0; \
- locinput = PL_reginput; \
- nextchr = UCHARAT(locinput);
-
-#define POP_STATE \
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth)); \
- depth--; \
- st--; \
- if (st < SLAB_FIRST(PL_regmatch_slab)) { \
- PL_regmatch_slab = PL_regmatch_slab->prev; \
- st = SLAB_LAST(PL_regmatch_slab); \
- } \
- PL_regmatch_state = st; \
- scan = st->scan; \
- next = st->next; \
- n = st->n; \
- locinput = st->locinput; \
- nextchr = UCHARAT(locinput);
/*
- regmatch - main matching routine
* allocated since entry are freed.
*/
+/* *** every FOO_fail should = FOO+1 */
+#define TRIE_next (REGNODE_MAX+1)
+#define TRIE_next_fail (REGNODE_MAX+2)
+#define EVAL_A (REGNODE_MAX+3)
+#define EVAL_A_fail (REGNODE_MAX+4)
+#define resume_CURLYX (REGNODE_MAX+5)
+#define resume_WHILEM1 (REGNODE_MAX+6)
+#define resume_WHILEM2 (REGNODE_MAX+7)
+#define resume_WHILEM3 (REGNODE_MAX+8)
+#define resume_WHILEM4 (REGNODE_MAX+9)
+#define resume_WHILEM5 (REGNODE_MAX+10)
+#define resume_WHILEM6 (REGNODE_MAX+11)
+#define BRANCH_next (REGNODE_MAX+12)
+#define BRANCH_next_fail (REGNODE_MAX+13)
+#define CURLYM_A (REGNODE_MAX+14)
+#define CURLYM_A_fail (REGNODE_MAX+15)
+#define CURLYM_B (REGNODE_MAX+16)
+#define CURLYM_B_fail (REGNODE_MAX+17)
+#define IFMATCH_A (REGNODE_MAX+18)
+#define IFMATCH_A_fail (REGNODE_MAX+19)
+#define CURLY_B_min_known (REGNODE_MAX+20)
+#define CURLY_B_min_known_fail (REGNODE_MAX+21)
+#define CURLY_B_min (REGNODE_MAX+22)
+#define CURLY_B_min_fail (REGNODE_MAX+23)
+#define CURLY_B_max (REGNODE_MAX+24)
+#define CURLY_B_max_fail (REGNODE_MAX+25)
+
+
#define REG_NODE_NUM(x) ((x) ? (int)((x)-prog) : -1)
+#ifdef DEBUGGING
+STATIC void
+S_debug_start_match(pTHX_ const regexp *prog, const bool do_utf8,
+ const char *start, const char *end, const char *blurb)
+{
+ const bool utf8_pat= prog->reganch & ROPT_UTF8 ? 1 : 0;
+ if (!PL_colorset)
+ reginitcolors();
+ {
+ RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0),
+ prog->precomp, prog->prelen, 60);
+
+ RE_PV_QUOTED_DECL(s1, do_utf8, PERL_DEBUG_PAD_ZERO(1),
+ start, end - start, 60);
+
+ PerlIO_printf(Perl_debug_log,
+ "%s%s REx%s %s against %s\n",
+ PL_colors[4], blurb, PL_colors[5], s0, s1);
+
+ if (do_utf8||utf8_pat)
+ PerlIO_printf(Perl_debug_log, "UTF-8 %s%s%s...\n",
+ utf8_pat ? "pattern" : "",
+ utf8_pat && do_utf8 ? " and " : "",
+ do_utf8 ? "string" : ""
+ );
+ }
+}
+
+STATIC void
+S_dump_exec_pos(pTHX_ const char *locinput,
+ const regnode *scan,
+ const char *loc_regeol,
+ const char *loc_bostr,
+ const char *loc_reg_starttry,
+ const bool do_utf8)
+{
+ const int docolor = *PL_colors[0] || *PL_colors[2] || *PL_colors[4];
+ const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
+ int l = (loc_regeol - locinput) > taill ? taill : (loc_regeol - locinput);
+ /* The part of the string before starttry has one color
+ (pref0_len chars), between starttry and current
+ position another one (pref_len - pref0_len chars),
+ after the current position the third one.
+ We assume that pref0_len <= pref_len, otherwise we
+ decrease pref0_len. */
+ int pref_len = (locinput - loc_bostr) > (5 + taill) - l
+ ? (5 + taill) - l : locinput - loc_bostr;
+ int pref0_len;
+
+ while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
+ pref_len++;
+ pref0_len = pref_len - (locinput - loc_reg_starttry);
+ if (l + pref_len < (5 + taill) && l < loc_regeol - locinput)
+ l = ( loc_regeol - locinput > (5 + taill) - pref_len
+ ? (5 + taill) - pref_len : loc_regeol - locinput);
+ while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
+ l--;
+ if (pref0_len < 0)
+ pref0_len = 0;
+ if (pref0_len > pref_len)
+ pref0_len = pref_len;
+ {
+ const int is_uni = (do_utf8 && OP(scan) != CANY) ? 1 : 0;
+
+ RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0),
+ (locinput - pref_len),pref0_len, 60, 4, 5);
+
+ RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1),
+ (locinput - pref_len + pref0_len),
+ pref_len - pref0_len, 60, 2, 3);
+
+ RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2),
+ locinput, loc_regeol - locinput, 10, 0, 1);
+
+ const STRLEN tlen=len0+len1+len2;
+ PerlIO_printf(Perl_debug_log,
+ "%4"IVdf" <%.*s%.*s%s%.*s>%*s|",
+ (IV)(locinput - loc_bostr),
+ len0, s0,
+ len1, s1,
+ (docolor ? "" : "> <"),
+ len2, s2,
+ tlen > 19 ? 0 : 19 - tlen,
+ "");
+ }
+}
+
+#endif
+
STATIC I32 /* 0 failure, 1 success */
S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
{
/* these variables are NOT saved during a recusive RFEGMATCH: */
register I32 nextchr; /* is always set to UCHARAT(locinput) */
- bool result; /* return value of S_regmatch */
- regnode *inner; /* Next node in internal branch. */
+ bool result = 0; /* return value of S_regmatch */
int depth = 0; /* depth of recursion */
- regmatch_state *newst; /* when pushing a state, this is the new one */
regmatch_state *yes_state = NULL; /* state to pop to on success of
subpattern */
+ U32 state_num;
+ I32 parenfloor = 0;
+
#ifdef DEBUGGING
- SV *re_debug_flags = NULL;
- GET_RE_DEBUG_FLAGS;
+ GET_RE_DEBUG_FLAGS_DECL;
PL_regindent++;
#endif
st->minmod = 0;
st->sw = 0;
st->logical = 0;
- st->unwind = 0;
st->cc = NULL;
+
/* Note that nextchr is a byte even in UTF */
nextchr = UCHARAT(locinput);
scan = prog;
DEBUG_EXECUTE_r( {
SV * const prop = sv_newmortal();
- const int docolor = *PL_colors[0];
- const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
- int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
- /* The part of the string before starttry has one color
- (pref0_len chars), between starttry and current
- position another one (pref_len - pref0_len chars),
- after the current position the third one.
- We assume that pref0_len <= pref_len, otherwise we
- decrease pref0_len. */
- int pref_len = (locinput - PL_bostr) > (5 + taill) - l
- ? (5 + taill) - l : locinput - PL_bostr;
- int pref0_len;
-
- while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
- pref_len++;
- pref0_len = pref_len - (locinput - PL_reg_starttry);
- if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
- l = ( PL_regeol - locinput > (5 + taill) - pref_len
- ? (5 + taill) - pref_len : PL_regeol - locinput);
- while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
- l--;
- if (pref0_len < 0)
- pref0_len = 0;
- if (pref0_len > pref_len)
- pref0_len = pref_len;
+ regnode *rnext=regnext(scan);
+ DUMP_EXEC_POS( locinput, scan, do_utf8 );
regprop(rex, prop, scan);
- {
- const char * const s0 =
- do_utf8 && OP(scan) != CANY ?
- pv_uni_display(PERL_DEBUG_PAD(0), (U8*)(locinput - pref_len),
- pref0_len, 60, UNI_DISPLAY_REGEX) :
- locinput - pref_len;
- const int len0 = do_utf8 ? (int)strlen(s0) : pref0_len;
- const char * const s1 = do_utf8 && OP(scan) != CANY ?
- pv_uni_display(PERL_DEBUG_PAD(1),
- (U8*)(locinput - pref_len + pref0_len),
- pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
- locinput - pref_len + pref0_len;
- const int len1 = do_utf8 ? (int)strlen(s1) : pref_len - pref0_len;
- const char * const s2 = do_utf8 && OP(scan) != CANY ?
- pv_uni_display(PERL_DEBUG_PAD(2), (U8*)locinput,
- PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
- locinput;
- const int len2 = do_utf8 ? (int)strlen(s2) : l;
- PerlIO_printf(Perl_debug_log,
- "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
- (IV)(locinput - PL_bostr),
- PL_colors[4],
- len0, s0,
- PL_colors[5],
- PL_colors[2],
- len1, s1,
- PL_colors[3],
- (docolor ? "" : "> <"),
- PL_colors[0],
- len2, s2,
- PL_colors[1],
- 15 - l - pref_len + 1,
- "",
- (IV)(scan - rex->program), PL_regindent*2, "",
- SvPVX_const(prop));
- }
+
+ PerlIO_printf(Perl_debug_log,
+ "%3"IVdf":%*s%s(%"IVdf")\n",
+ (IV)(scan - rex->program), PL_regindent*2, "",
+ SvPVX_const(prop),
+ (PL_regkind[OP(scan)] == END || !rnext) ?
+ 0 : (IV)(rnext - rex->program));
});
next = scan + NEXT_OFF(scan);
if (next == scan)
next = NULL;
+ state_num = OP(scan);
- switch (OP(scan)) {
+ reenter_switch:
+ switch (state_num) {
case BOL:
if (locinput == PL_bostr)
{
nextchr = UCHARAT(++locinput);
break;
-
-
- /*
- traverse the TRIE keeping track of all accepting states
- we transition through until we get to a failing node.
- */
+#undef ST
+#define ST st->u.trie
+ case TRIEC:
+ /* In this case the charclass data is available inline so
+ we can fail fast without a lot of extra overhead.
+ */
+ if (scan->flags == EXACT || !do_utf8) {
+ if(!ANYOF_BITMAP_TEST(scan, *locinput)) {
+ DEBUG_EXECUTE_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s %sfailed to match trie start class...%s\n",
+ REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
+ );
+ sayNO_SILENT;
+ /* NOTREACHED */
+ }
+ }
+ /* FALL THROUGH */
case TRIE:
{
+ /* what type of TRIE am I? (utf8 makes this contextual) */
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 * const 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)
) {
} else {
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
- "%*s %sfailed to match start class...%s\n",
+ "%*s %sfailed to match trie start class...%s\n",
REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
}
}
- {
+
+ {
U8 *uc = ( U8* )locinput;
- U16 charid = 0;
- U32 base = 0;
- UV uvc = 0;
+
STRLEN len = 0;
STRLEN foldlen = 0;
U8 *uscan = (U8*)NULL;
STRLEN bufflen=0;
SV *sv_accept_buff = NULL;
+ U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
+
+ ST.accepted = 0; /* how many accepting states we have seen */
+ ST.B = next;
+ ST.jump = trie->jump;
+
+#ifdef DEBUGGING
+ ST.me = scan;
+#endif
+
+
- st->u.trie.accepted = 0; /* how many accepting states we have seen */
- result = 0;
+ /*
+ traverse the TRIE keeping track of all accepting states
+ we transition through until we get to a failing node.
+ */
while ( state && uc <= (U8*)PL_regeol ) {
-
- if (trie->states[ state ].wordnum) {
- if (!st->u.trie.accepted ) {
+ U32 base = trie->states[ state ].trans.base;
+ UV uvc;
+ U16 charid;
+ /* We use charid to hold the wordnum as we don't use it
+ for charid until after we have done the wordnum logic.
+ We define an alias just so that the wordnum logic reads
+ more naturally. */
+
+#define got_wordnum charid
+ got_wordnum = trie->states[ state ].wordnum;
+
+ if ( got_wordnum ) {
+ if ( ! ST.accepted ) {
ENTER;
SAVETMPS;
bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
sv_accept_buff=newSV(bufflen *
sizeof(reg_trie_accepted) - 1);
- SvCUR_set(sv_accept_buff,
- sizeof(reg_trie_accepted));
+ SvCUR_set(sv_accept_buff, 0);
SvPOK_on(sv_accept_buff);
sv_2mortal(sv_accept_buff);
- st->u.trie.accept_buff =
+ SAVETMPS;
+ ST.accept_buff =
(reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
}
- else {
- if (st->u.trie.accepted >= bufflen) {
+ do {
+ if (ST.accepted >= bufflen) {
bufflen *= 2;
- st->u.trie.accept_buff =(reg_trie_accepted*)
+ ST.accept_buff =(reg_trie_accepted*)
SvGROW(sv_accept_buff,
bufflen * sizeof(reg_trie_accepted));
}
SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
+ sizeof(reg_trie_accepted));
- }
- st->u.trie.accept_buff[st->u.trie.accepted].wordnum = trie->states[state].wordnum;
- st->u.trie.accept_buff[st->u.trie.accepted].endpos = uc;
- ++st->u.trie.accepted;
- }
- base = trie->states[ state ].trans.base;
- DEBUG_TRIE_EXECUTE_r(
+ ST.accept_buff[ST.accepted].wordnum = got_wordnum;
+ ST.accept_buff[ST.accepted].endpos = uc;
+ ++ST.accepted;
+ } while (trie->nextword && (got_wordnum= trie->nextword[got_wordnum]));
+ }
+#undef got_wordnum
+
+ DEBUG_TRIE_EXECUTE_r({
+ DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
PerlIO_printf( Perl_debug_log,
- "%*s %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
- REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
- (UV)state, (UV)base, (UV)st->u.trie.accepted );
- );
+ "%*s %sState: %4"UVxf" Accepted: %4"UVxf" ",
+ 2+PL_regindent * 2, "", PL_colors[4],
+ (UV)state, (UV)ST.accepted );
+ });
if ( base ) {
- switch (trie_type) {
- case trie_utf8_fold:
- if ( foldlen>0 ) {
- uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
- foldlen -= len;
- uscan += len;
- len=0;
- } else {
- U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
- uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
- uvc = to_uni_fold( uvc, foldbuf, &foldlen );
- foldlen -= UNISKIP( uvc );
- uscan = foldbuf + UNISKIP( uvc );
- }
- break;
- case trie_utf8:
- uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN,
- &len, uniflags );
- break;
- case trie_plain:
- uvc = (UV)*uc;
- len = 1;
- }
-
- if (uvc < 256) {
- charid = trie->charmap[ uvc ];
- }
- else {
- charid = 0;
- if (trie->widecharmap) {
- SV** const svpp = hv_fetch(trie->widecharmap,
- (char*)&uvc, sizeof(UV), 0);
- if (svpp)
- charid = (U16)SvIV(*svpp);
- }
- }
+ REXEC_TRIE_READ_CHAR(trie_type, trie, uc, uscan, len,
+ uvc, charid, foldlen, foldbuf, uniflags);
if (charid &&
(base + charid > trie->uniquecharcount )
}
DEBUG_TRIE_EXECUTE_r(
PerlIO_printf( Perl_debug_log,
- "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
+ "Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
charid, uvc, (UV)state, PL_colors[5] );
);
}
- if (!st->u.trie.accepted )
+ if (!ST.accepted )
sayNO;
+ DEBUG_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log,
+ "%*s %sgot %"IVdf" possible matches%s\n",
+ REPORT_CODE_OFF + PL_regindent * 2, "",
+ PL_colors[4], (IV)ST.accepted, PL_colors[5] );
+ );
+ }}
+
+ /* FALL THROUGH */
+
+ case TRIE_next_fail: /* we failed - try next alterative */
+
+ if ( ST.accepted == 1 ) {
+ /* only one choice left - just continue */
+ DEBUG_EXECUTE_r({
+ reg_trie_data * const trie
+ = (reg_trie_data*)rex->data->data[ ARG(ST.me) ];
+ SV ** const tmp = RX_DEBUG(reginfo->prog)
+ ? av_fetch( trie->words, ST.accept_buff[ 0 ].wordnum-1, 0 )
+ : NULL;
+ PerlIO_printf( Perl_debug_log,
+ "%*s %sonly one match left: #%d <%s>%s\n",
+ REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
+ ST.accept_buff[ 0 ].wordnum,
+ tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
+ PL_colors[5] );
+ });
+ PL_reginput = (char *)ST.accept_buff[ 0 ].endpos;
+ /* in this case we free tmps/leave before we call regmatch
+ as we wont be using accept_buff again. */
+ FREETMPS;
+ LEAVE;
+ locinput = PL_reginput;
+ nextchr = UCHARAT(locinput);
+
+ if ( !ST.jump )
+ scan = ST.B;
+ else
+ scan = ST.B - ST.jump[ST.accept_buff[0].wordnum];
+
+ continue; /* execute rest of RE */
+ }
+
+ if (!ST.accepted-- ) {
+ FREETMPS;
+ LEAVE;
+ sayNO;
+ }
+
/*
- There was at least one accepting state that we
- transitioned through. Presumably the number of accepting
- states is going to be low, typically one or two. So we
- simply scan through to find the one with lowest wordnum.
- Once we find it, we swap the last state into its place
- and decrement the size. We then try to match the rest of
- the pattern at the point where the word ends, if we
- succeed then we end the loop, otherwise the loop
- eventually terminates once all of the accepting states
- have been tried.
- */
+ There are at least two accepting states left. Presumably
+ the number of accepting states is going to be low,
+ typically two. So we simply scan through to find the one
+ with lowest wordnum. Once we find it, we swap the last
+ state into its place and decrement the size. We then try to
+ match the rest of the pattern at the point where the word
+ ends. If we succeed, control just continues along the
+ regex; if we fail we return here to try the next accepting
+ state
+ */
- if ( st->u.trie.accepted == 1 ) {
- DEBUG_EXECUTE_r({
- SV ** const tmp = av_fetch( trie->words, st->u.trie.accept_buff[ 0 ].wordnum-1, 0 );
- PerlIO_printf( Perl_debug_log,
- "%*s %sonly one match : #%d <%s>%s\n",
- REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
- st->u.trie.accept_buff[ 0 ].wordnum,
- tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
- PL_colors[5] );
- });
- PL_reginput = (char *)st->u.trie.accept_buff[ 0 ].endpos;
- /* in this case we free tmps/leave before we call regmatch
- as we wont be using accept_buff again. */
- FREETMPS;
- LEAVE;
- REGMATCH(scan + NEXT_OFF(scan), TRIE1);
- /*** all unsaved local vars undefined at this point */
- } else {
- DEBUG_EXECUTE_r(
- PerlIO_printf( Perl_debug_log,"%*s %sgot %"IVdf" possible matches%s\n",
- REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4], (IV)st->u.trie.accepted,
- PL_colors[5] );
- );
- while ( !result && st->u.trie.accepted-- ) {
- U32 best = 0;
- U32 cur;
- for( cur = 1 ; cur <= st->u.trie.accepted ; cur++ ) {
- DEBUG_TRIE_EXECUTE_r(
- PerlIO_printf( Perl_debug_log,
- "%*s %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
- REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
- (IV)best, st->u.trie.accept_buff[ best ].wordnum, (IV)cur,
- st->u.trie.accept_buff[ cur ].wordnum, PL_colors[5] );
- );
-
- if (st->u.trie.accept_buff[cur].wordnum <
- st->u.trie.accept_buff[best].wordnum)
- best = cur;
- }
- DEBUG_EXECUTE_r({
- 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 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", REG_NODE_NUM(scan),
- PL_colors[5] );
- });
- if ( best<st->u.trie.accepted ) {
- reg_trie_accepted tmp = st->u.trie.accept_buff[ best ];
- st->u.trie.accept_buff[ best ] = st->u.trie.accept_buff[ st->u.trie.accepted ];
- st->u.trie.accept_buff[ st->u.trie.accepted ] = tmp;
- best = st->u.trie.accepted;
- }
- PL_reginput = (char *)st->u.trie.accept_buff[ best ].endpos;
-
- /*
- as far as I can tell we only need the SAVETMPS/FREETMPS
- for re's with EVAL in them but I'm leaving them in for
- all until I can be sure.
- */
- SAVETMPS;
- REGMATCH(scan + NEXT_OFF(scan), TRIE2);
- /*** all unsaved local vars undefined at this point */
- FREETMPS;
- }
- FREETMPS;
- LEAVE;
+ {
+ U32 best = 0;
+ U32 cur;
+ for( cur = 1 ; cur <= ST.accepted ; cur++ ) {
+ DEBUG_TRIE_EXECUTE_r(
+ PerlIO_printf( Perl_debug_log,
+ "%*s %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
+ REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
+ (IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
+ ST.accept_buff[ cur ].wordnum, PL_colors[5] );
+ );
+
+ if (ST.accept_buff[cur].wordnum <
+ ST.accept_buff[best].wordnum)
+ best = cur;
}
-
- if (result) {
- sayYES;
- } else {
- sayNO;
+
+ DEBUG_EXECUTE_r({
+ reg_trie_data * const trie
+ = (reg_trie_data*)rex->data->data[ ARG(ST.me) ];
+ SV ** const tmp = RX_DEBUG(reginfo->prog)
+ ? av_fetch( trie->words, ST.accept_buff[ best ].wordnum - 1, 0 )
+ : NULL;
+ 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.accept_buff[best].wordnum,
+ tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr", REG_NODE_NUM(scan),
+ PL_colors[5] );
+ });
+
+ if ( best<ST.accepted ) {
+ reg_trie_accepted tmp = ST.accept_buff[ best ];
+ ST.accept_buff[ best ] = ST.accept_buff[ ST.accepted ];
+ ST.accept_buff[ ST.accepted ] = tmp;
+ best = ST.accepted;
}
- }}
- /* unreached codepoint */
+ PL_reginput = (char *)ST.accept_buff[ best ].endpos;
+ if ( !ST.jump ) {
+ PUSH_STATE_GOTO(TRIE_next, ST.B);
+ /* NOTREACHED */
+ } else {
+ PUSH_STATE_GOTO(TRIE_next, ST.B - ST.jump[ST.accept_buff[best].wordnum]);
+ /* NOTREACHED */
+ }
+ /* NOTREACHED */
+ }
+ /* NOTREACHED */
+
+#undef ST
+
case EXACT: {
char *s = STRING(scan);
st->ln = STR_LEN(scan);
if (do_utf8 != UTF) {
/* The target and the pattern have differing utf8ness. */
char *l = locinput;
- const char *e = s + st->ln;
+ const char * const e = s + st->ln;
if (do_utf8) {
/* The target is utf8, the pattern is not utf8. */
PL_reg_flags |= RF_tainted;
/* FALL THROUGH */
case EXACTF: {
- char *s = STRING(scan);
+ char * const s = STRING(scan);
st->ln = STR_LEN(scan);
if (do_utf8 || UTF) {
/* Either target or the pattern are utf8. */
- char *l = locinput;
+ const char * const l = locinput;
char *e = PL_regeol;
if (ibcmp_utf8(s, 0, st->ln, (bool)UTF,
break;
case BACK:
break;
- case EVAL:
+
+#undef ST
+#define ST st->u.eval
+
+ case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */
{
SV *ret;
{
* necessary */
MAGIC *mg = NULL;
- SV *sv;
+ const SV *sv;
if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
mg = mg_find(sv, PERL_MAGIC_qr);
else if (SvSMAGICAL(ret)) {
}
/* run the pattern returned from (??{...}) */
-
- DEBUG_EXECUTE_r(
- PerlIO_printf(Perl_debug_log,
- "Entering embedded \"%s%.60s%s%s\"\n",
- PL_colors[0],
- re->precomp,
- PL_colors[1],
- (strlen(re->precomp) > 60 ? "..." : ""))
- );
-
- st->u.eval.cp = regcppush(0); /* Save *all* the positions. */
- REGCP_SET(st->u.eval.lastcp);
+ ST.cp = regcppush(0); /* Save *all* the positions. */
+ REGCP_SET(ST.lastcp);
*PL_reglastparen = 0;
*PL_reglastcloseparen = 0;
PL_reginput = locinput;
PL_reg_maxiter = 0;
st->logical = 0;
- st->u.eval.toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
+ ST.toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
((re->reganch & ROPT_UTF8) != 0);
- if (st->u.eval.toggleutf) PL_reg_flags ^= RF_utf8;
- st->u.eval.prev_rex = rex;
+ if (ST.toggleutf) PL_reg_flags ^= RF_utf8;
+ ST.prev_rex = rex;
rex = re;
- /* resume to current state on success */
- st->u.yes.prev_yes_state = yes_state;
- yes_state = st;
- PUSH_STATE(newst, resume_EVAL);
- st = newst;
-
+ ST.B = next;
+ DEBUG_EXECUTE_r(
+ debug_start_match(re, do_utf8, locinput, PL_regeol,
+ "Matching embedded");
+ );
/* now continue from first node in postoned RE */
- next = re->program + 1;
- break;
+ PUSH_YES_STATE_GOTO(EVAL_A, re->program + 1);
/* NOTREACHED */
}
/* /(?(?{...})X|Y)/ */
st->logical = 0;
break;
}
- case OPEN:
- n = ARG(scan); /* which paren pair */
- PL_reg_start_tmp[n] = locinput;
- if (n > PL_regsize)
- PL_regsize = n;
- break;
- case CLOSE:
- n = ARG(scan); /* which paren pair */
- PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
- PL_regendp[n] = locinput - PL_bostr;
- if (n > (I32)*PL_reglastparen)
- *PL_reglastparen = n;
- *PL_reglastcloseparen = n;
- break;
- case GROUPP:
- n = ARG(scan); /* which paren pair */
- st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
- break;
- case IFTHEN:
- PL_reg_leftiter = PL_reg_maxiter; /* Void cache */
- if (st->sw)
- next = NEXTOPER(NEXTOPER(scan));
- else {
+
+ case EVAL_A: /* successfully ran inner rex (??{rex}) */
+ if (ST.toggleutf)
+ PL_reg_flags ^= RF_utf8;
+ ReREFCNT_dec(rex);
+ rex = ST.prev_rex;
+ /* XXXX This is too dramatic a measure... */
+ PL_reg_maxiter = 0;
+ /* Restore parens of the caller without popping the
+ * savestack */
+ {
+ const I32 tmp = PL_savestack_ix;
+ PL_savestack_ix = ST.lastcp;
+ regcppop(rex);
+ PL_savestack_ix = tmp;
+ }
+ PL_reginput = locinput;
+ /* continue at the node following the (??{...}) */
+ scan = ST.B;
+ continue;
+ case EVAL_A_fail: /* unsuccessfully ran inner rex (??{rex}) */
+ /* Restore state to the outer re then re-throw the failure */
+ if (ST.toggleutf)
+ PL_reg_flags ^= RF_utf8;
+ ReREFCNT_dec(rex);
+ rex = ST.prev_rex;
+
+ /* XXXX This is too dramatic a measure... */
+ PL_reg_maxiter = 0;
+
+ PL_reginput = locinput;
+ REGCP_UNWIND(ST.lastcp);
+ regcppop(rex);
+ sayNO_SILENT;
+
+#undef ST
+
+ case OPEN:
+ n = ARG(scan); /* which paren pair */
+ PL_reg_start_tmp[n] = locinput;
+ if (n > PL_regsize)
+ PL_regsize = n;
+ break;
+ case CLOSE:
+ n = ARG(scan); /* which paren pair */
+ PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
+ PL_regendp[n] = locinput - PL_bostr;
+ if (n > (I32)*PL_reglastparen)
+ *PL_reglastparen = n;
+ *PL_reglastcloseparen = n;
+ break;
+ case GROUPP:
+ n = ARG(scan); /* which paren pair */
+ st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
+ break;
+ case IFTHEN:
+ PL_reg_leftiter = PL_reg_maxiter; /* Void cache */
+ if (st->sw)
+ next = NEXTOPER(NEXTOPER(scan));
+ else {
next = scan + ARG(scan);
if (OP(next) == IFTHEN) /* Fake one. */
next = NEXTOPER(NEXTOPER(next));
case CURLYX: {
/* No need to save/restore up to this paren */
- I32 parenfloor = scan->flags;
-
+ parenfloor = scan->flags;
+
/* Dave says:
CURLYX and WHILEM are always paired: they're the moral
PL_reg_leftiter = PL_reg_maxiter;
}
if (PL_reg_leftiter-- == 0) {
- const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
+ const I32 size = (PL_reg_maxiter + 7)/8;
if (PL_reg_poscache) {
if ((I32)PL_reg_poscache_size < size) {
Renew(PL_reg_poscache, size, char);
if (PL_reg_leftiter < 0) {
st->u.whilem.cache_offset = locinput - PL_bostr;
- st->u.whilem.cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
+ st->u.whilem.cache_offset = (scan->flags & 0xf) - 1
+ st->u.whilem.cache_offset * (scan->flags>>4);
st->u.whilem.cache_bit = st->u.whilem.cache_offset % 8;
st->u.whilem.cache_offset /= 8;
"%*s already tried at this position...\n",
REPORT_CODE_OFF+PL_regindent*2, "")
);
- if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
- /* cache records success */
- sayYES;
- else
- /* cache records failure */
- sayNO_SILENT;
+ sayNO; /* cache records failure */
}
}
}
st->cc = st->u.whilem.savecc;
if (result) {
regcpblow(st->u.whilem.cp);
- CACHEsayYES; /* All done. */
+ sayYES; /* All done. */
}
REGCP_UNWIND(st->u.whilem.lastcp);
regcppop(rex);
/*** all unsaved local vars undefined at this point */
if (result) {
regcpblow(st->u.whilem.cp);
- CACHEsayYES;
+ sayYES;
}
REGCP_UNWIND(st->u.whilem.lastcp);
regcppop(rex);
/*** all unsaved local vars undefined at this point */
if (result) {
regcpblow(st->u.whilem.cp);
- CACHEsayYES;
+ sayYES;
}
REGCP_UNWIND(st->u.whilem.lastcp);
regcppop(rex); /* Restore some previous $<digit>s? */
/*** all unsaved local vars undefined at this point */
st->cc = st->u.whilem.savecc;
if (result)
- CACHEsayYES;
+ sayYES;
if (st->cc->u.curlyx.outercc)
st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
st->cc->u.curlyx.cur = n - 1;
CACHEsayNO;
}
/* NOTREACHED */
- case BRANCHJ:
+
+#undef ST
+#define ST st->u.branch
+
+ case BRANCHJ: /* /(...|A|...)/ with long next pointer */
next = scan + ARG(scan);
if (next == scan)
next = NULL;
- inner = NEXTOPER(NEXTOPER(scan));
- goto do_branch;
- case BRANCH:
- inner = NEXTOPER(scan);
- do_branch:
- {
- I32 type;
- type = OP(scan);
- if (!next || OP(next) != type) /* No choice. */
- next = inner; /* Avoid recursion. */
- else {
- const I32 lastparen = *PL_reglastparen;
- /* Put unwinding data on stack */
- const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
- re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
-
- uw->prev = st->unwind;
- st->unwind = unwind1;
- uw->type = ((type == BRANCH)
- ? RE_UNWIND_BRANCH
- : RE_UNWIND_BRANCHJ);
- uw->lastparen = lastparen;
- uw->next = next;
- uw->locinput = locinput;
- uw->nextchr = nextchr;
- uw->minmod = st->minmod;
-#ifdef DEBUGGING
- uw->regindent = ++PL_regindent;
-#endif
+ scan = NEXTOPER(scan);
+ /* FALL THROUGH */
- REGCP_SET(uw->lastcp);
+ case BRANCH: /* /(...|A|...)/ */
+ scan = NEXTOPER(scan); /* scan now points to inner node */
+ if (!next || (OP(next) != BRANCH && OP(next) != BRANCHJ))
+ /* last branch; skip state push and jump direct to node */
+ continue;
+ ST.lastparen = *PL_reglastparen;
+ ST.next_branch = next;
+ REGCP_SET(ST.cp);
+ PL_reginput = locinput;
- /* Now go into the first branch */
- next = inner;
- }
- }
- break;
+ /* Now go into the branch */
+ PUSH_STATE_GOTO(BRANCH_next, scan);
+ /* NOTREACHED */
+
+ case BRANCH_next_fail: /* that branch failed; try the next, if any */
+ REGCP_UNWIND(ST.cp);
+ for (n = *PL_reglastparen; n > ST.lastparen; n--)
+ PL_regendp[n] = -1;
+ *PL_reglastparen = n;
+ scan = ST.next_branch;
+ /* no more branches? */
+ if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ))
+ sayNO;
+ continue; /* execute next BRANCH[J] op */
+ /* NOTREACHED */
+
case MINMOD:
st->minmod = 1;
break;
- case CURLYM:
- {
- st->u.curlym.l = st->u.curlym.matches = 0;
-
- /* We suppose that the next guy does not need
- backtracking: in particular, it is of constant non-zero length,
- and has no parenths to influence future backrefs. */
- st->ln = ARG1(scan); /* min to match */
- n = ARG2(scan); /* max to match */
- st->u.curlym.paren = scan->flags;
- if (st->u.curlym.paren) {
- if (st->u.curlym.paren > PL_regsize)
- PL_regsize = st->u.curlym.paren;
- if (st->u.curlym.paren > (I32)*PL_reglastparen)
- *PL_reglastparen = st->u.curlym.paren;
- }
+
+#undef ST
+#define ST st->u.curlym
+
+ case CURLYM: /* /A{m,n}B/ where A is fixed-length */
+
+ /* This is an optimisation of CURLYX that enables us to push
+ * only a single backtracking state, no matter now many matches
+ * there are in {m,n}. It relies on the pattern being constant
+ * length, with no parens to influence future backrefs
+ */
+
+ ST.me = scan;
scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
- if (st->u.curlym.paren)
+
+ /* if paren positive, emulate an OPEN/CLOSE around A */
+ if (ST.me->flags) {
+ I32 paren = ST.me->flags;
+ if (paren > PL_regsize)
+ PL_regsize = paren;
+ if (paren > (I32)*PL_reglastparen)
+ *PL_reglastparen = paren;
scan += NEXT_OFF(scan); /* Skip former OPEN. */
- PL_reginput = locinput;
- st->u.curlym.maxwanted = st->minmod ? st->ln : n;
- while (PL_reginput < PL_regeol && st->u.curlym.matches < st->u.curlym.maxwanted) {
- /* resume to current state on success */
- st->u.yes.prev_yes_state = yes_state;
- yes_state = st;
- REGMATCH(scan, CURLYM1);
- yes_state = st->u.yes.prev_yes_state;
- /*** all unsaved local vars undefined at this point */
- if (!result)
- break;
- /* on first match, determine length, u.curlym.l */
- if (!st->u.curlym.matches++) {
- if (PL_reg_match_utf8) {
- char *s = locinput;
- while (s < PL_reginput) {
- st->u.curlym.l++;
- s += UTF8SKIP(s);
- }
- }
- else {
- st->u.curlym.l = PL_reginput - locinput;
- }
- if (st->u.curlym.l == 0) {
- st->u.curlym.matches = st->u.curlym.maxwanted;
- break;
- }
- }
- locinput = PL_reginput;
}
+ ST.A = scan;
+ ST.B = next;
+ ST.alen = 0;
+ ST.count = 0;
+ ST.minmod = st->minmod;
+ st->minmod = 0;
+ ST.c1 = CHRTEST_UNINIT;
+ REGCP_SET(ST.cp);
+ if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */
+ goto curlym_do_B;
+
+ curlym_do_A: /* execute the A in /A{m,n}B/ */
PL_reginput = locinput;
- if (st->u.curlym.matches < st->ln) {
- st->minmod = 0;
- sayNO;
- }
+ PUSH_YES_STATE_GOTO(CURLYM_A, ST.A); /* match A */
+ /* NOTREACHED */
+ case CURLYM_A: /* we've just matched an A */
+ locinput = st->locinput;
+ nextchr = UCHARAT(locinput);
+
+ ST.count++;
+ /* after first match, determine A's length: u.curlym.alen */
+ if (ST.count == 1) {
+ if (PL_reg_match_utf8) {
+ char *s = locinput;
+ while (s < PL_reginput) {
+ ST.alen++;
+ s += UTF8SKIP(s);
+ }
+ }
+ else {
+ ST.alen = PL_reginput - locinput;
+ }
+ if (ST.alen == 0)
+ ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
+ }
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
- "%*s matched %"IVdf" times, len=%"IVdf"...\n",
- (int)(REPORT_CODE_OFF+PL_regindent*2), "",
- (IV) st->u.curlym.matches, (IV)st->u.curlym.l)
+ "%*s CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
+ (int)(REPORT_CODE_OFF+(PL_regindent*2)), "",
+ (IV) ST.count, (IV)ST.alen)
);
- /* calculate c1 and c1 for possible match of 1st char
- * following curly */
- 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)
- && PL_regkind[OP(text_node)] != REF)
- {
- st->u.curlym.c1 = (U8)*STRING(text_node);
- st->u.curlym.c2 =
- (OP(text_node) == EXACTF || OP(text_node) == REFF)
- ? PL_fold[st->u.curlym.c1]
- : (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
- ? PL_fold_locale[st->u.curlym.c1]
- : st->u.curlym.c1;
- }
- }
+ locinput = PL_reginput;
+ if (ST.count < (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)))
+ goto curlym_do_A; /* try to match another A */
+ goto curlym_do_B; /* try to match B */
- REGCP_SET(st->u.curlym.lastcp);
+ case CURLYM_A_fail: /* just failed to match an A */
+ REGCP_UNWIND(ST.cp);
+ if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ )
+ sayNO;
- st->u.curlym.minmod = st->minmod;
- st->minmod = 0;
- while (st->u.curlym.matches >= st->ln
- && (st->u.curlym.matches <= n
- /* for REG_INFTY, ln could overflow to negative */
- || (n == REG_INFTY && st->u.curlym.matches >= 0)))
- {
- /* If it could work, try it. */
- if (st->u.curlym.c1 == CHRTEST_VOID ||
- UCHARAT(PL_reginput) == st->u.curlym.c1 ||
- UCHARAT(PL_reginput) == st->u.curlym.c2)
- {
- DEBUG_EXECUTE_r(
- PerlIO_printf(Perl_debug_log,
- "%*s trying tail with matches=%"IVdf"...\n",
- (int)(REPORT_CODE_OFF+PL_regindent*2),
- "", (IV)st->u.curlym.matches)
- );
- if (st->u.curlym.paren) {
- if (st->u.curlym.matches) {
- PL_regstartp[st->u.curlym.paren]
- = HOPc(PL_reginput, -st->u.curlym.l) - PL_bostr;
- PL_regendp[st->u.curlym.paren] = PL_reginput - PL_bostr;
- }
- else
- PL_regendp[st->u.curlym.paren] = -1;
- }
- /* resume to current state on success */
- st->u.yes.prev_yes_state = yes_state;
- yes_state = st;
- REGMATCH(next, CURLYM2);
- yes_state = st->u.yes.prev_yes_state;
- /*** all unsaved local vars undefined at this point */
- if (result)
- /* XXX tmp sayYES; */
- sayYES_FINAL;
- REGCP_UNWIND(st->u.curlym.lastcp);
- }
- /* Couldn't or didn't -- move forward/backward. */
- if (st->u.curlym.minmod) {
- PL_reginput = locinput;
- /* resume to current state on success */
- st->u.yes.prev_yes_state = yes_state;
- yes_state = st;
- REGMATCH(scan, CURLYM3);
- yes_state = st->u.yes.prev_yes_state;
- /*** all unsaved local vars undefined at this point */
- if (result) {
- st->u.curlym.matches++;
- locinput = PL_reginput;
+ curlym_do_B: /* execute the B in /A{m,n}B/ */
+ PL_reginput = locinput;
+ if (ST.c1 == CHRTEST_UNINIT) {
+ /* calculate c1 and c2 for possible match of 1st char
+ * following curly */
+ ST.c1 = ST.c2 = CHRTEST_VOID;
+ if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) {
+ regnode *text_node = ST.B;
+ if (! HAS_TEXT(text_node))
+ FIND_NEXT_IMPT(text_node);
+ if (HAS_TEXT(text_node)
+ && PL_regkind[OP(text_node)] != REF)
+ {
+ ST.c1 = (U8)*STRING(text_node);
+ ST.c2 =
+ (OP(text_node) == EXACTF || OP(text_node) == REFF)
+ ? PL_fold[ST.c1]
+ : (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
+ ? PL_fold_locale[ST.c1]
+ : ST.c1;
}
- else
- sayNO;
}
- else {
- st->u.curlym.matches--;
- locinput = HOPc(locinput, -st->u.curlym.l);
- PL_reginput = locinput;
+ }
+
+ DEBUG_EXECUTE_r(
+ PerlIO_printf(Perl_debug_log,
+ "%*s CURLYM trying tail with matches=%"IVdf"...\n",
+ (int)(REPORT_CODE_OFF+(PL_regindent*2)),
+ "", (IV)ST.count)
+ );
+ if (ST.c1 != CHRTEST_VOID
+ && UCHARAT(PL_reginput) != ST.c1
+ && UCHARAT(PL_reginput) != ST.c2)
+ {
+ /* simulate B failing */
+ state_num = CURLYM_B_fail;
+ goto reenter_switch;
+ }
+
+ if (ST.me->flags) {
+ /* mark current A as captured */
+ I32 paren = ST.me->flags;
+ if (ST.count) {
+ PL_regstartp[paren]
+ = HOPc(PL_reginput, -ST.alen) - PL_bostr;
+ PL_regendp[paren] = PL_reginput - PL_bostr;
}
+ else
+ PL_regendp[paren] = -1;
}
- sayNO;
+ PUSH_STATE_GOTO(CURLYM_B, ST.B); /* match B */
/* NOTREACHED */
- break;
- }
- case CURLYN:
- st->u.plus.paren = scan->flags; /* Which paren to set */
- if (st->u.plus.paren > PL_regsize)
- PL_regsize = st->u.plus.paren;
- if (st->u.plus.paren > (I32)*PL_reglastparen)
- *PL_reglastparen = st->u.plus.paren;
- st->ln = ARG1(scan); /* min to match */
- n = ARG2(scan); /* max to match */
- scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
- goto repeat;
- case CURLY:
- st->u.plus.paren = 0;
- st->ln = ARG1(scan); /* min to match */
- n = ARG2(scan); /* max to match */
- scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
- goto repeat;
- case STAR:
- st->ln = 0;
- n = REG_INFTY;
+
+ case CURLYM_B_fail: /* just failed to match a B */
+ REGCP_UNWIND(ST.cp);
+ if (ST.minmod) {
+ if (ST.count == ARG2(ST.me) /* max */)
+ sayNO;
+ goto curlym_do_A; /* try to match a further A */
+ }
+ /* backtrack one A */
+ if (ST.count == ARG1(ST.me) /* min */)
+ sayNO;
+ ST.count--;
+ locinput = HOPc(locinput, -ST.alen);
+ goto curlym_do_B; /* try to match B */
+
+#undef ST
+#define ST st->u.curly
+
+#define CURLY_SETPAREN(paren, success) \
+ if (paren) { \
+ if (success) { \
+ PL_regstartp[paren] = HOPc(locinput, -1) - PL_bostr; \
+ PL_regendp[paren] = locinput - PL_bostr; \
+ } \
+ else \
+ PL_regendp[paren] = -1; \
+ }
+
+ case STAR: /* /A*B/ where A is width 1 */
+ ST.paren = 0;
+ ST.min = 0;
+ ST.max = REG_INFTY;
scan = NEXTOPER(scan);
- st->u.plus.paren = 0;
goto repeat;
- case PLUS:
- st->ln = 1;
- n = REG_INFTY;
+ case PLUS: /* /A+B/ where A is width 1 */
+ ST.paren = 0;
+ ST.min = 1;
+ ST.max = REG_INFTY;
scan = NEXTOPER(scan);
- st->u.plus.paren = 0;
+ goto repeat;
+ case CURLYN: /* /(A){m,n}B/ where A is width 1 */
+ ST.paren = scan->flags; /* Which paren to set */
+ if (ST.paren > PL_regsize)
+ PL_regsize = ST.paren;
+ if (ST.paren > (I32)*PL_reglastparen)
+ *PL_reglastparen = ST.paren;
+ ST.min = ARG1(scan); /* min to match */
+ ST.max = ARG2(scan); /* max to match */
+ scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
+ goto repeat;
+ case CURLY: /* /A{m,n}B/ where A is width 1 */
+ ST.paren = 0;
+ ST.min = ARG1(scan); /* min to match */
+ ST.max = ARG2(scan); /* max to match */
+ scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
repeat:
/*
* Lookahead to avoid useless match attempts
* when we know what character comes next.
- */
-
- /*
+ *
* Used to only do .*x and .*?x, but now it allows
* for )'s, ('s and (?{ ... })'s to be in the way
* of the quantifier and the EXACT-like node. -- japhy
*/
+ if (ST.min > ST.max) /* XXX make this a compile-time check? */
+ sayNO;
if (HAS_TEXT(next) || JUMPABLE(next)) {
U8 *s;
regnode *text_node = next;
FIND_NEXT_IMPT(text_node);
if (! HAS_TEXT(text_node))
- st->u.plus.c1 = st->u.plus.c2 = CHRTEST_VOID;
+ ST.c1 = ST.c2 = CHRTEST_VOID;
else {
if (PL_regkind[OP(text_node)] == REF) {
- st->u.plus.c1 = st->u.plus.c2 = CHRTEST_VOID;
+ ST.c1 = ST.c2 = CHRTEST_VOID;
goto assume_ok_easy;
}
- else { s = (U8*)STRING(text_node); }
+ else
+ s = (U8*)STRING(text_node);
if (!UTF) {
- st->u.plus.c2 = st->u.plus.c1 = *s;
+ ST.c2 = ST.c1 = *s;
if (OP(text_node) == EXACTF || OP(text_node) == REFF)
- st->u.plus.c2 = PL_fold[st->u.plus.c1];
+ ST.c2 = PL_fold[ST.c1];
else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
- st->u.plus.c2 = PL_fold_locale[st->u.plus.c1];
+ ST.c2 = PL_fold_locale[ST.c1];
}
else { /* UTF */
if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
-
- st->u.plus.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
- uniflags);
- st->u.plus.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
- uniflags);
+#ifdef EBCDIC
+ ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
+ ckWARN(WARN_UTF8) ?
+ 0 : UTF8_ALLOW_ANY);
+ ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
+ ckWARN(WARN_UTF8) ?
+ 0 : UTF8_ALLOW_ANY);
+#else
+ ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
+ uniflags);
+ ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
+ uniflags);
+#endif
}
else {
- st->u.plus.c2 = st->u.plus.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
+ ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
uniflags);
}
}
}
}
else
- st->u.plus.c1 = st->u.plus.c2 = CHRTEST_VOID;
+ ST.c1 = ST.c2 = CHRTEST_VOID;
assume_ok_easy:
+
+ ST.A = scan;
+ ST.B = next;
PL_reginput = locinput;
if (st->minmod) {
st->minmod = 0;
- if (st->ln && regrepeat(rex, scan, st->ln) < st->ln)
+ if (ST.min && regrepeat(rex, ST.A, ST.min) < ST.min)
sayNO;
+ ST.count = ST.min;
locinput = PL_reginput;
- REGCP_SET(st->u.plus.lastcp);
- if (st->u.plus.c1 != CHRTEST_VOID) {
- st->u.plus.old = locinput;
- st->u.plus.count = 0;
-
- if (n == REG_INFTY) {
- st->u.plus.e = PL_regeol - 1;
- if (do_utf8)
- while (UTF8_IS_CONTINUATION(*(U8*)st->u.plus.e))
- st->u.plus.e--;
- }
- else if (do_utf8) {
- int m = n - st->ln;
- for (st->u.plus.e = locinput;
- m >0 && st->u.plus.e + UTF8SKIP(st->u.plus.e) <= PL_regeol; m--)
- st->u.plus.e += UTF8SKIP(st->u.plus.e);
+ REGCP_SET(ST.cp);
+ if (ST.c1 == CHRTEST_VOID)
+ goto curly_try_B_min;
+
+ ST.oldloc = locinput;
+
+ /* set ST.maxpos to the furthest point along the
+ * string that could possibly match */
+ if (ST.max == REG_INFTY) {
+ ST.maxpos = PL_regeol - 1;
+ if (do_utf8)
+ while (UTF8_IS_CONTINUATION(*(U8*)ST.maxpos))
+ ST.maxpos--;
+ }
+ else if (do_utf8) {
+ int m = ST.max - ST.min;
+ for (ST.maxpos = locinput;
+ m >0 && ST.maxpos + UTF8SKIP(ST.maxpos) <= PL_regeol; m--)
+ ST.maxpos += UTF8SKIP(ST.maxpos);
+ }
+ else {
+ ST.maxpos = locinput + ST.max - ST.min;
+ if (ST.maxpos >= PL_regeol)
+ ST.maxpos = PL_regeol - 1;
+ }
+ goto curly_try_B_min_known;
+
+ }
+ else {
+ ST.count = regrepeat(rex, ST.A, ST.max);
+ locinput = PL_reginput;
+ if (ST.count < ST.min)
+ sayNO;
+ if ((ST.count > ST.min)
+ && (PL_regkind[OP(ST.B)] == EOL) && (OP(ST.B) != MEOL))
+ {
+ /* A{m,n} must come at the end of the string, there's
+ * no point in backing off ... */
+ ST.min = ST.count;
+ /* ...except that $ and \Z can match before *and* after
+ newline at the end. Consider "\n\n" =~ /\n+\Z\n/.
+ We may back off by one in this case. */
+ if (UCHARAT(PL_reginput - 1) == '\n' && OP(ST.B) != EOS)
+ ST.min--;
+ }
+ REGCP_SET(ST.cp);
+ goto curly_try_B_max;
+ }
+ /* NOTREACHED */
+
+
+ case CURLY_B_min_known_fail:
+ /* failed to find B in a non-greedy match where c1,c2 valid */
+ if (ST.paren && ST.count)
+ PL_regendp[ST.paren] = -1;
+
+ PL_reginput = locinput; /* Could be reset... */
+ REGCP_UNWIND(ST.cp);
+ /* Couldn't or didn't -- move forward. */
+ ST.oldloc = locinput;
+ if (do_utf8)
+ locinput += UTF8SKIP(locinput);
+ else
+ locinput++;
+ ST.count++;
+ curly_try_B_min_known:
+ /* find the next place where 'B' could work, then call B */
+ {
+ int n;
+ if (do_utf8) {
+ n = (ST.oldloc == locinput) ? 0 : 1;
+ if (ST.c1 == ST.c2) {
+ STRLEN len;
+ /* set n to utf8_distance(oldloc, locinput) */
+ while (locinput <= ST.maxpos &&
+ utf8n_to_uvchr((U8*)locinput,
+ UTF8_MAXBYTES, &len,
+ uniflags) != (UV)ST.c1) {
+ locinput += len;
+ n++;
+ }
}
else {
- st->u.plus.e = locinput + n - st->ln;
- if (st->u.plus.e >= PL_regeol)
- st->u.plus.e = PL_regeol - 1;
- }
- while (1) {
- /* Find place 'next' could work */
- if (!do_utf8) {
- if (st->u.plus.c1 == st->u.plus.c2) {
- while (locinput <= st->u.plus.e &&
- UCHARAT(locinput) != st->u.plus.c1)
- locinput++;
- } else {
- while (locinput <= st->u.plus.e
- && UCHARAT(locinput) != st->u.plus.c1
- && UCHARAT(locinput) != st->u.plus.c2)
- locinput++;
- }
- st->u.plus.count = locinput - st->u.plus.old;
- }
- else {
- if (st->u.plus.c1 == st->u.plus.c2) {
- STRLEN len;
- /* count initialised to
- * utf8_distance(old, locinput) */
- while (locinput <= st->u.plus.e &&
- utf8n_to_uvchr((U8*)locinput,
- UTF8_MAXBYTES, &len,
- uniflags) != (UV)st->u.plus.c1) {
- locinput += len;
- st->u.plus.count++;
- }
- } else {
- /* count initialised to
- * utf8_distance(old, locinput) */
- while (locinput <= st->u.plus.e) {
- STRLEN len;
- const UV c = utf8n_to_uvchr((U8*)locinput,
- UTF8_MAXBYTES, &len,
- uniflags);
- if (c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
- break;
- locinput += len;
- st->u.plus.count++;
- }
- }
- }
- if (locinput > st->u.plus.e)
- sayNO;
- /* PL_reginput == old now */
- if (locinput != st->u.plus.old) {
- st->ln = 1; /* Did some */
- if (regrepeat(rex, scan, st->u.plus.count) < st->u.plus.count)
- sayNO;
+ /* set n to utf8_distance(oldloc, locinput) */
+ while (locinput <= ST.maxpos) {
+ STRLEN len;
+ const UV c = utf8n_to_uvchr((U8*)locinput,
+ UTF8_MAXBYTES, &len,
+ uniflags);
+ if (c == (UV)ST.c1 || c == (UV)ST.c2)
+ break;
+ locinput += len;
+ n++;
}
- /* PL_reginput == locinput now */
- TRYPAREN(st->u.plus.paren, st->ln, locinput, PLUS1);
- /*** all unsaved local vars undefined at this point */
- PL_reginput = locinput; /* Could be reset... */
- REGCP_UNWIND(st->u.plus.lastcp);
- /* Couldn't or didn't -- move forward. */
- st->u.plus.old = locinput;
- if (do_utf8)
- locinput += UTF8SKIP(locinput);
- else
- locinput++;
- st->u.plus.count = 1;
}
}
- else
- while (n >= st->ln || (n == REG_INFTY && st->ln > 0)) { /* ln overflow ? */
- UV c;
- if (st->u.plus.c1 != CHRTEST_VOID) {
- if (do_utf8)
- c = utf8n_to_uvchr((U8*)PL_reginput,
- UTF8_MAXBYTES, 0,
- uniflags);
- else
- c = UCHARAT(PL_reginput);
- /* If it could work, try it. */
- if (c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
- {
- TRYPAREN(st->u.plus.paren, st->ln, PL_reginput, PLUS2);
- /*** all unsaved local vars undefined at this point */
- REGCP_UNWIND(st->u.plus.lastcp);
- }
- }
- /* If it could work, try it. */
- else if (st->u.plus.c1 == CHRTEST_VOID)
- {
- TRYPAREN(st->u.plus.paren, st->ln, PL_reginput, PLUS3);
- /*** all unsaved local vars undefined at this point */
- REGCP_UNWIND(st->u.plus.lastcp);
+ else {
+ if (ST.c1 == ST.c2) {
+ while (locinput <= ST.maxpos &&
+ UCHARAT(locinput) != ST.c1)
+ locinput++;
}
- /* Couldn't or didn't -- move forward. */
- PL_reginput = locinput;
- if (regrepeat(rex, scan, 1)) {
- st->ln++;
- locinput = PL_reginput;
+ else {
+ while (locinput <= ST.maxpos
+ && UCHARAT(locinput) != ST.c1
+ && UCHARAT(locinput) != ST.c2)
+ locinput++;
}
- else
+ n = locinput - ST.oldloc;
+ }
+ if (locinput > ST.maxpos)
+ sayNO;
+ /* PL_reginput == oldloc now */
+ if (n) {
+ ST.count += n;
+ if (regrepeat(rex, ST.A, n) < n)
sayNO;
}
+ PL_reginput = locinput;
+ CURLY_SETPAREN(ST.paren, ST.count);
+ PUSH_STATE_GOTO(CURLY_B_min_known, ST.B);
}
- else {
- n = regrepeat(rex, scan, n);
+ /* NOTREACHED */
+
+
+ case CURLY_B_min_fail:
+ /* failed to find B in a non-greedy match where c1,c2 invalid */
+ if (ST.paren && ST.count)
+ PL_regendp[ST.paren] = -1;
+
+ REGCP_UNWIND(ST.cp);
+ /* failed -- move forward one */
+ PL_reginput = locinput;
+ if (regrepeat(rex, ST.A, 1)) {
+ ST.count++;
locinput = PL_reginput;
- if ((st->ln < n) && (PL_regkind[OP(next)] == EOL) &&
- (OP(next) != MEOL || OP(next) == SEOL || OP(next) == EOS))
+ if (ST.count <= ST.max || (ST.max == REG_INFTY &&
+ ST.count > 0)) /* count overflow ? */
{
- st->ln = n; /* why back off? */
- /* ...because $ and \Z can match before *and* after
- newline at the end. Consider "\n\n" =~ /\n+\Z\n/.
- We should back off by one in this case. */
- if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
- st->ln--;
- }
- REGCP_SET(st->u.plus.lastcp);
- {
- UV c = 0;
- while (n >= st->ln) {
- if (st->u.plus.c1 != CHRTEST_VOID) {
- if (do_utf8)
- c = utf8n_to_uvchr((U8*)PL_reginput,
- UTF8_MAXBYTES, 0,
- uniflags);
- else
- c = UCHARAT(PL_reginput);
- }
- /* If it could work, try it. */
- if (st->u.plus.c1 == CHRTEST_VOID || c == (UV)st->u.plus.c1 || c == (UV)st->u.plus.c2)
- {
- TRYPAREN(st->u.plus.paren, n, PL_reginput, PLUS4);
- /*** all unsaved local vars undefined at this point */
- REGCP_UNWIND(st->u.plus.lastcp);
- }
- /* Couldn't or didn't -- back up. */
- n--;
- PL_reginput = locinput = HOPc(locinput, -1);
- }
+ curly_try_B_min:
+ CURLY_SETPAREN(ST.paren, ST.count);
+ PUSH_STATE_GOTO(CURLY_B_min, ST.B);
}
}
sayNO;
- break;
+ /* NOTREACHED */
+
+
+ curly_try_B_max:
+ /* a successful greedy match: now try to match B */
+ {
+ UV c = 0;
+ if (ST.c1 != CHRTEST_VOID)
+ c = do_utf8 ? utf8n_to_uvchr((U8*)PL_reginput,
+ UTF8_MAXBYTES, 0, uniflags)
+ : (UV) UCHARAT(PL_reginput);
+ /* If it could work, try it. */
+ if (ST.c1 == CHRTEST_VOID || c == (UV)ST.c1 || c == (UV)ST.c2) {
+ CURLY_SETPAREN(ST.paren, ST.count);
+ PUSH_STATE_GOTO(CURLY_B_max, ST.B);
+ /* NOTREACHED */
+ }
+ }
+ /* FALL THROUGH */
+ case CURLY_B_max_fail:
+ /* failed to find B in a greedy match */
+ if (ST.paren && ST.count)
+ PL_regendp[ST.paren] = -1;
+
+ REGCP_UNWIND(ST.cp);
+ /* back up. */
+ if (--ST.count < ST.min)
+ sayNO;
+ PL_reginput = locinput = HOPc(locinput, -1);
+ goto curly_try_B_max;
+
+#undef ST
+
+
case END:
if (locinput < reginfo->till) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
PL_reginput = locinput; /* put where regtry can find it */
sayYES_FINAL; /* Success! */
- case SUSPEND: /* (?>FOO) */
- st->u.ifmatch.wanted = 1;
+#undef ST
+#define ST st->u.ifmatch
+
+ case SUSPEND: /* (?>A) */
+ ST.wanted = 1;
PL_reginput = locinput;
goto do_ifmatch;
- case UNLESSM: /* -ve lookaround: (?!FOO), or with flags, (?<!foo) */
- st->u.ifmatch.wanted = 0;
+ case UNLESSM: /* -ve lookaround: (?!A), or with flags, (?<!A) */
+ ST.wanted = 0;
goto ifmatch_trivial_fail_test;
- case IFMATCH: /* +ve lookaround: (?=FOO), or with flags, (?<=foo) */
- st->u.ifmatch.wanted = 1;
+ case IFMATCH: /* +ve lookaround: (?=A), or with flags, (?<=A) */
+ ST.wanted = 1;
ifmatch_trivial_fail_test:
if (scan->flags) {
char * const s = HOPBACKc(locinput, scan->flags);
/* trivial fail */
if (st->logical) {
st->logical = 0;
- st->sw = 1 - (bool)st->u.ifmatch.wanted;
+ st->sw = 1 - (bool)ST.wanted;
}
- else if (st->u.ifmatch.wanted)
+ else if (ST.wanted)
sayNO;
next = scan + ARG(scan);
if (next == scan)
PL_reginput = locinput;
do_ifmatch:
- /* resume to current state on success */
- st->u.yes.prev_yes_state = yes_state;
- yes_state = st;
- PUSH_STATE(newst, resume_IFMATCH);
- st = newst;
- next = NEXTOPER(NEXTOPER(scan));
- break;
+ ST.me = scan;
+ /* execute body of (?...A) */
+ PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)));
+ /* NOTREACHED */
+
+ case IFMATCH_A_fail: /* body of (?...A) failed */
+ ST.wanted = !ST.wanted;
+ /* FALL THROUGH */
+
+ case IFMATCH_A: /* body of (?...A) succeeded */
+ if (st->logical) {
+ st->logical = 0;
+ st->sw = (bool)ST.wanted;
+ }
+ else if (!ST.wanted)
+ sayNO;
+
+ if (OP(ST.me) == SUSPEND)
+ locinput = PL_reginput;
+ else {
+ locinput = PL_reginput = st->locinput;
+ nextchr = UCHARAT(locinput);
+ }
+ scan = ST.me + ARG(ST.me);
+ if (scan == ST.me)
+ scan = NULL;
+ continue; /* execute B */
+
+#undef ST
case LONGJMP:
next = scan + ARG(scan);
Perl_croak(aTHX_ "regexp memory corruption");
}
- reenter:
scan = next;
continue;
/* NOTREACHED */
+ push_yes_state:
+ /* push a state that backtracks on success */
+ st->u.yes.prev_yes_state = yes_state;
+ yes_state = st;
+ /* FALL THROUGH */
+ push_state:
+ /* push a new regex state, then continue at scan */
+ {
+ regmatch_state *newst;
+
+ depth++;
+ DEBUG_STATE_r(PerlIO_printf(Perl_debug_log,
+ "PUSH STATE(%d)\n", depth));
+ st->locinput = locinput;
+ newst = st+1;
+ if (newst > SLAB_LAST(PL_regmatch_slab))
+ newst = S_push_slab(aTHX);
+ PL_regmatch_state = newst;
+ newst->cc = st->cc;
+ /* XXX probably don't need to initialise these */
+ newst->minmod = 0;
+ newst->sw = 0;
+ newst->logical = 0;
+
+
+ locinput = PL_reginput;
+ nextchr = UCHARAT(locinput);
+ st = newst;
+ continue;
+ /* NOTREACHED */
+ }
+
/* simulate recursively calling regmatch(), but without actually
* recursing - ie save the current state on the heap rather than on
* the stack, then re-enter the loop. This avoids complex regexes
regmatch_state *oldst = st;
depth++;
+ DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "PUSH RECURSE STATE(%d)\n", depth));
/* grab the next free state slot */
st++;
st->minmod = 0;
st->sw = 0;
st->logical = 0;
- st->unwind = 0;
+
#ifdef DEBUGGING
PL_regindent++;
#endif
if (yes_state) {
/* we have successfully completed a subexpression, but we must now
* pop to the state marked by yes_state and continue from there */
-
- /*XXX tmp for CURLYM*/
- regmatch_slab * const oslab = PL_regmatch_slab;
- regmatch_state * const ost = st;
- regmatch_state * const oys = yes_state;
- int odepth = depth;
-
assert(st != yes_state);
while (yes_state < SLAB_FIRST(PL_regmatch_slab)
|| yes_state > SLAB_LAST(PL_regmatch_slab))
st = SLAB_LAST(PL_regmatch_slab);
}
depth -= (st - yes_state);
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "POP STATE TO (%d)\n", depth));
+ DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATES (%"UVuf"..%"UVuf")\n",
+ (UV)(depth+1), (UV)(depth+(st - yes_state))));
st = yes_state;
yes_state = st->u.yes.prev_yes_state;
PL_regmatch_state = st;
switch (st->resume_state) {
- case resume_EVAL:
- if (st->u.eval.toggleutf)
- PL_reg_flags ^= RF_utf8;
- ReREFCNT_dec(rex);
- rex = st->u.eval.prev_rex;
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
- /* Restore parens of the caller without popping the
- * savestack */
- {
- const I32 tmp = PL_savestack_ix;
- PL_savestack_ix = st->u.eval.lastcp;
- regcppop(rex);
- PL_savestack_ix = tmp;
- }
- PL_reginput = locinput;
- /* continue at the node following the (??{...}) */
- next = st->next;
- goto reenter;
-
- case resume_IFMATCH:
- if (st->logical) {
- st->logical = 0;
- st->sw = (bool)st->u.ifmatch.wanted;
- }
- else if (!st->u.ifmatch.wanted)
- sayNO;
-
- if (OP(st->scan) == SUSPEND)
- locinput = PL_reginput;
- else {
- locinput = PL_reginput = st->locinput;
- nextchr = UCHARAT(locinput);
- }
- next = st->scan + ARG(st->scan);
- if (next == st->scan)
- next = NULL;
- goto reenter;
-
- /* XXX tmp don't handle yes_state yet */
- case resume_CURLYM1:
- case resume_CURLYM2:
- case resume_CURLYM3:
- PL_regmatch_slab =oslab;
- st = ost;
- PL_regmatch_state = st;
- depth = odepth;
- yes_state = oys;
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "XXX revering a CURLYM\n"));
- goto yes;
-
+ case EVAL_A:
+ case IFMATCH_A:
+ case CURLYM_A:
+ state_num = st->resume_state;
+ goto reenter_switch;
+
+ case CURLYM_B:
+ case BRANCH_next:
+ case TRIE_next:
+ case CURLY_B_max:
default:
- Perl_croak(aTHX_ "unexpected yes reume state");
+ Perl_croak(aTHX_ "unexpected yes resume state");
}
}
result = 1;
/* XXX this is duplicate(ish) code to that in the do_no section.
- * eventually a yes should just pop the stack back to the current
- * yes_state */
+ * will disappear when REGFMATCH goes */
if (depth) {
/* restore previous state and re-enter */
- POP_STATE;
+ DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth));
+ depth--;
+ st--;
+ if (st < SLAB_FIRST(PL_regmatch_slab)) {
+ PL_regmatch_slab = PL_regmatch_slab->prev;
+ st = SLAB_LAST(PL_regmatch_slab);
+ }
+ PL_regmatch_state = st;
+ scan = st->scan;
+ next = st->next;
+ n = st->n;
+ locinput= st->locinput;
+ nextchr = UCHARAT(locinput);
switch (st->resume_state) {
- case resume_TRIE1:
- goto resume_point_TRIE1;
- case resume_TRIE2:
- goto resume_point_TRIE2;
case resume_CURLYX:
goto resume_point_CURLYX;
case resume_WHILEM1:
goto resume_point_WHILEM5;
case resume_WHILEM6:
goto resume_point_WHILEM6;
- case resume_CURLYM1:
- goto resume_point_CURLYM1;
- case resume_CURLYM2:
- goto resume_point_CURLYM2;
- case resume_CURLYM3:
- goto resume_point_CURLYM3;
- case resume_PLUS1:
- goto resume_point_PLUS1;
- case resume_PLUS2:
- goto resume_point_PLUS2;
- case resume_PLUS3:
- goto resume_point_PLUS3;
- case resume_PLUS4:
- goto resume_point_PLUS4;
-
- case resume_IFMATCH:
- case resume_EVAL:
+
+ case TRIE_next:
+ case CURLYM_A:
+ case CURLYM_B:
+ case EVAL_A:
+ case IFMATCH_A:
+ case BRANCH_next:
+ case CURLY_B_max:
+ case CURLY_B_min:
+ case CURLY_B_min_known:
+ break;
+
default:
Perl_croak(aTHX_ "regexp resume memory corruption");
}
no:
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
- "%*s %sfailed...%s\n",
- REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
+ "%*s %sfailed...%s\n",
+ REPORT_CODE_OFF+PL_regindent*2, "",
+ PL_colors[4], PL_colors[5])
);
- goto do_no;
no_final:
do_no:
- if (st->unwind) {
- re_unwind_t * const uw = SSPTRt(st->unwind,re_unwind_t);
-
- switch (uw->type) {
- case RE_UNWIND_BRANCH:
- case RE_UNWIND_BRANCHJ:
- {
- re_unwind_branch_t * const uwb = &(uw->branch);
- const I32 lastparen = uwb->lastparen;
-
- REGCP_UNWIND(uwb->lastcp);
- for (n = *PL_reglastparen; n > lastparen; n--)
- PL_regendp[n] = -1;
- *PL_reglastparen = n;
- scan = next = uwb->next;
- st->minmod = uwb->minmod;
- if ( !scan ||
- OP(scan) != (uwb->type == RE_UNWIND_BRANCH
- ? BRANCH : BRANCHJ) ) { /* Failure */
- st->unwind = uwb->prev;
-#ifdef DEBUGGING
- PL_regindent--;
-#endif
- goto do_no;
- }
- /* Have more choice yet. Reuse the same uwb. */
- if ((n = (uwb->type == RE_UNWIND_BRANCH
- ? NEXT_OFF(next) : ARG(next))))
- next += n;
- else
- next = NULL; /* XXXX Needn't unwinding in this case... */
- uwb->next = next;
- next = NEXTOPER(scan);
- if (uwb->type == RE_UNWIND_BRANCHJ)
- next = NEXTOPER(next);
- locinput = uwb->locinput;
- nextchr = uwb->nextchr;
-#ifdef DEBUGGING
- PL_regindent = uwb->regindent;
-#endif
-
- goto reenter;
- }
- /* NOTREACHED */
- default:
- Perl_croak(aTHX_ "regexp unwind memory corruption");
- }
- /* NOTREACHED */
- }
#ifdef DEBUGGING
PL_regindent--;
if (depth) {
/* there's a previous state to backtrack to */
- POP_STATE;
- switch (st->resume_state) {
- case resume_TRIE1:
- goto resume_point_TRIE1;
- case resume_TRIE2:
- goto resume_point_TRIE2;
- case resume_EVAL:
- /* we have failed an (??{...}). Restore state to the outer re
- * then re-throw the failure */
- if (st->u.eval.toggleutf)
- PL_reg_flags ^= RF_utf8;
- ReREFCNT_dec(rex);
- rex = st->u.eval.prev_rex;
- yes_state = st->u.yes.prev_yes_state;
-
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
-
- PL_reginput = locinput;
- REGCP_UNWIND(st->u.eval.lastcp);
- regcppop(rex);
- goto do_no;
+ DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATE(%d)\n", depth));
+ depth--;
+ st--;
+ if (st < SLAB_FIRST(PL_regmatch_slab)) {
+ PL_regmatch_slab = PL_regmatch_slab->prev;
+ st = SLAB_LAST(PL_regmatch_slab);
+ }
+ PL_regmatch_state = st;
+ scan = st->scan;
+ next = st->next;
+ n = st->n;
+ locinput= st->locinput;
+ nextchr = UCHARAT(locinput);
+ switch (st->resume_state) {
case resume_CURLYX:
goto resume_point_CURLYX;
case resume_WHILEM1:
goto resume_point_WHILEM5;
case resume_WHILEM6:
goto resume_point_WHILEM6;
- case resume_CURLYM1:
- goto resume_point_CURLYM1;
- case resume_CURLYM2:
- goto resume_point_CURLYM2;
- case resume_CURLYM3:
- goto resume_point_CURLYM3;
- case resume_IFMATCH:
- yes_state = st->u.yes.prev_yes_state;
- if (st->logical) {
- st->logical = 0;
- st->sw = !st->u.ifmatch.wanted;
- }
- else if (st->u.ifmatch.wanted)
- sayNO;
- assert(OP(scan) != SUSPEND); /* XXX DAPM tmp */
- locinput = PL_reginput = st->locinput;
- nextchr = UCHARAT(locinput);
- next = scan + ARG(scan);
- if (next == scan)
- next = NULL;
- goto reenter;
-
- case resume_PLUS1:
- goto resume_point_PLUS1;
- case resume_PLUS2:
- goto resume_point_PLUS2;
- case resume_PLUS3:
- goto resume_point_PLUS3;
- case resume_PLUS4:
- goto resume_point_PLUS4;
+ case TRIE_next:
+ case EVAL_A:
+ case BRANCH_next:
+ case CURLYM_A:
+ case CURLYM_B:
+ case IFMATCH_A:
+ case CURLY_B_max:
+ case CURLY_B_min:
+ case CURLY_B_min_known:
+ if (yes_state == st)
+ yes_state = st->u.yes.prev_yes_state;
+ state_num = st->resume_state + 1; /* failure = success + 1 */
+ goto reenter_switch;
+
default:
Perl_croak(aTHX_ "regexp resume memory corruption");
}
PL_reginput = scan;
DEBUG_r({
- SV *re_debug_flags = NULL;
- SV * const prop = sv_newmortal();
- GET_RE_DEBUG_FLAGS;
- DEBUG_EXECUTE_r({
- regprop(prog, prop, p);
- PerlIO_printf(Perl_debug_log,
- "%*s %s can match %"IVdf" times out of %"IVdf"...\n",
- REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
- });
+ GET_RE_DEBUG_FLAGS_DECL;
+ DEBUG_EXECUTE_r({
+ SV * const prop = sv_newmortal();
+ regprop(prog, prop, p);
+ PerlIO_printf(Perl_debug_log,
+ "%*s %s can match %"IVdf" times out of %"IVdf"...\n",
+ REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
});
+ });
return(c);
}
-#ifndef PERL_IN_XSUB_RE
+#if !defined(PERL_IN_XSUB_RE) || defined(PLUGGABLE_RE_EXTENSION)
/*
- regclass_swash - prepare the utf8 swash
*/
c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
(UTF8_ALLOW_DEFAULT & UTF8_ALLOW_ANYUV) | UTF8_CHECK_ONLY);
/* see [perl #37836] for UTF8_ALLOW_ANYUV */
- if (len == (STRLEN)-1)
+ if (len == (STRLEN)-1)
Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
}
}
}
else {
- while (off++) {
- if (s > lim) {
- s--;
- if (UTF8_IS_CONTINUED(*s)) {
- while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
- s--;
- }
- /* XXX could check well-formedness here */
+ while (off++ && s > lim) {
+ s--;
+ if (UTF8_IS_CONTINUED(*s)) {
+ while (s > lim && UTF8_IS_CONTINUATION(*s))
+ s--;
}
+ /* XXX could check well-formedness here */
}
}
return s;
}
STATIC U8 *
+S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
+{
+ dVAR;
+ if (off >= 0) {
+ while (off-- && s < rlim) {
+ /* XXX could check well-formedness here */
+ s += UTF8SKIP(s);
+ }
+ }
+ else {
+ while (off++ && s > llim) {
+ s--;
+ if (UTF8_IS_CONTINUED(*s)) {
+ while (s > llim && UTF8_IS_CONTINUATION(*s))
+ s--;
+ }
+ /* XXX could check well-formedness here */
+ }
+ }
+ return s;
+}
+
+
+STATIC U8 *
S_reghopmaybe3(U8* s, I32 off, const U8* lim)
{
dVAR;
return NULL;
}
else {
- while (off++) {
- if (s > lim) {
- s--;
- if (UTF8_IS_CONTINUED(*s)) {
- while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
- s--;
- }
- /* XXX could check well-formedness here */
+ while (off++ && s > lim) {
+ s--;
+ if (UTF8_IS_CONTINUED(*s)) {
+ while (s > lim && UTF8_IS_CONTINUATION(*s))
+ s--;
}
- else
- break;
+ /* XXX could check well-formedness here */
}
if (off <= 0)
return NULL;
https://perl5.git.perl.org / perl5.git / blobdiff