#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 /* Pattern contains multibyte chars? */
#define UTF ((PL_reg_flags & RF_utf8) != 0)
#ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */
if (end_shift < 0)
Perl_croak(aTHX_ "panic: end_shift: %"IVdf" pattern:\n%s\n ",
- end_shift,prog->precomp);
+ (IV)end_shift, prog->precomp);
#endif
restart:
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),
+ (int)(end_point - start_point) > 20 ? 20 : (int)(end_point - start_point),
start_point);
});
}
- t= HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
+ t= (char*)HOP3( s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : strpos);
DEBUG_OPTIMISE_r(
PerlIO_printf(Perl_debug_log,
if (s - strpos > prog->check_offset_max /* signed-corrected t > strpos */
&& (!do_utf8
- || ((t = (char*)reghopmaybe3((U8*)s, -prog->check_offset_max, (prog->check_offset_max<0) ? strend : 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
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));
+ (IV)start_shift, check_at - strbeg, s - strbeg, endpos - strbeg));
t = s;
s = find_byclass(prog, prog->regstclass, s, endpos, NULL);
I32 scream_pos = -1; /* Internal iterator of scream. */
char *scream_olds = NULL;
SV* const oreplsv = GvSV(PL_replgv);
- const bool do_utf8 = DO_UTF8(sv);
+ const bool do_utf8 = (bool)DO_UTF8(sv);
I32 multiline;
regmatch_info reginfo; /* create some info to pass to regtry etc */
}
}
goto phooey;
- } else if (prog->reganch & ROPT_ANCH_GPOS) {
+ } else if (ROPT_GPOS_CHECK == (prog->reganch & ROPT_GPOS_CHECK))
+ {
+ /* the warning about reginfo.ganch being used without intialization
+ is bogus -- we set it above, when prog->reganch & ROPT_GPOS_SEEN
+ and we only enter this block when the same bit is set. */
if (regtry(®info, reginfo.ganch))
goto got_it;
goto phooey;
regexp *prog = reginfo->prog;
GET_RE_DEBUG_FLAGS_DECL;
-#ifdef DEBUGGING
- PL_regindent = 0; /* XXXX Not good when matches are reenterable... */
-#endif
if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
MAGIC *mg;
#define sayYES goto yes
#define sayNO goto no
-#define sayNO_ANYOF goto no_anyof
-#define sayYES_FINAL goto yes_final
-#define sayNO_FINAL goto no_final
-#define sayNO_SILENT goto do_no
+#define sayNO_SILENT goto no_silent
#define saySAME(x) if (x) goto yes; else goto no
-#define CACHEsayNO STMT_START { \
+/* we dont use STMT_START/END here because it leads to
+ "unreachable code" warnings, which are bogus, but distracting. */
+#define CACHEsayNO \
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
-
+ sayNO
/* 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
- left these messages outdented making reviewing a debug output
- quite difficult.
+ 'failed...' are printed. It should be set such that messages
+ are inline with the regop output that created them.
*/
-#define REPORT_CODE_OFF 29
+#define REPORT_CODE_OFF 32
/* Make sure there is a test for this +1 options in re_tests */
* 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 DEBUG_STATE_pp(pp) \
+ DEBUG_STATE_r({ \
+ DUMP_EXEC_POS(locinput, scan, do_utf8); \
+ PerlIO_printf(Perl_debug_log, \
+ " %*s"pp" %s\n", \
+ depth*2, "", \
+ reg_name[st->resume_state] ); \
+ });
#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)
len1, s1,
(docolor ? "" : "> <"),
len2, s2,
- tlen > 19 ? 0 : 19 - tlen,
+ (int)(tlen > 19 ? 0 : 19 - tlen),
"");
}
}
int depth = 0; /* depth of recursion */
regmatch_state *yes_state = NULL; /* state to pop to on success of
subpattern */
+ regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */
+ struct regmatch_state *cur_curlyx = NULL; /* most recent curlyx */
U32 state_num;
I32 parenfloor = 0;
#ifdef DEBUGGING
GET_RE_DEBUG_FLAGS_DECL;
- PL_regindent++;
#endif
/* on first ever call to regmatch, allocate first slab */
st->minmod = 0;
st->sw = 0;
st->logical = 0;
- st->cc = NULL;
+ cur_curlyx = NULL;
/* Note that nextchr is a byte even in UTF */
nextchr = UCHARAT(locinput);
PerlIO_printf(Perl_debug_log,
"%3"IVdf":%*s%s(%"IVdf")\n",
- (IV)(scan - rex->program), PL_regindent*2, "",
+ (IV)(scan - rex->program), depth*2, "",
SvPVX_const(prop),
(PL_regkind[OP(scan)] == END || !rnext) ?
0 : (IV)(rnext - rex->program));
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])
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
/* NOTREACHED */
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s %smatched empty string...%s\n",
- REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
);
break;
} else {
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])
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
}
while ( state && uc <= (U8*)PL_regeol ) {
U32 base = trie->states[ state ].trans.base;
- UV uvc;
+ UV uvc = 0;
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.
DUMP_EXEC_POS( (char *)uc, scan, do_utf8 );
PerlIO_printf( Perl_debug_log,
"%*s %sState: %4"UVxf" Accepted: %4"UVxf" ",
- 2+PL_regindent * 2, "", PL_colors[4],
+ 2+depth * 2, "", PL_colors[4],
(UV)state, (UV)ST.accepted );
});
DEBUG_EXECUTE_r(
PerlIO_printf( Perl_debug_log,
"%*s %sgot %"IVdf" possible matches%s\n",
- REPORT_CODE_OFF + PL_regindent * 2, "",
+ REPORT_CODE_OFF + depth * 2, "",
PL_colors[4], (IV)ST.accepted, PL_colors[5] );
);
}}
: NULL;
PerlIO_printf( Perl_debug_log,
"%*s %sonly one match left: #%d <%s>%s\n",
- REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4],
ST.accept_buff[ 0 ].wordnum,
tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
PL_colors[5] );
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],
+ REPORT_CODE_OFF + depth * 2, "", PL_colors[4],
(IV)best, ST.accept_buff[ best ].wordnum, (IV)cur,
ST.accept_buff[ cur ].wordnum, PL_colors[5] );
);
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],
+ regnode *nextop=!ST.jump ?
+ ST.B :
+ ST.B - ST.jump[ST.accept_buff[best].wordnum];
+ PerlIO_printf( Perl_debug_log,
+ "%*s %strying alternation #%d <%s> at node #%d %s\n",
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4],
ST.accept_buff[best].wordnum,
- tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr", REG_NODE_NUM(scan),
+ tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
+ REG_NODE_NUM(nextop),
PL_colors[5] );
});
STRLEN inclasslen = PL_regeol - locinput;
if (!reginclass(rex, scan, (U8*)locinput, &inclasslen, do_utf8))
- sayNO_ANYOF;
+ goto anyof_fail;
if (locinput >= PL_regeol)
sayNO;
locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
if (nextchr < 0)
nextchr = UCHARAT(locinput);
if (!REGINCLASS(rex, scan, (U8*)locinput))
- sayNO_ANYOF;
+ goto anyof_fail;
if (!nextchr && locinput >= PL_regeol)
sayNO;
nextchr = UCHARAT(++locinput);
break;
}
- no_anyof:
+ anyof_fail:
/* If we might have the case of the German sharp s
* in a casefolding Unicode character class. */
Zero(&pm, 1, PMOP);
if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
- re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
+ re = CALLREGCOMP((char*)t, (char*)t + len, &pm);
if (!(SvFLAGS(ret)
& (SVs_TEMP | SVs_PADTMP | SVf_READONLY
| SVs_GMG)))
PL_reg_maxiter = 0;
st->logical = 0;
- ST.toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
- ((re->reganch & ROPT_UTF8) != 0);
- if (ST.toggleutf) PL_reg_flags ^= RF_utf8;
+ ST.toggle_reg_flags = PL_reg_flags;
+ if (re->reganch & ROPT_UTF8)
+ PL_reg_flags |= RF_utf8;
+ else
+ PL_reg_flags &= ~RF_utf8;
+ ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */
+
ST.prev_rex = rex;
+ ST.prev_curlyx = cur_curlyx;
rex = re;
-
+ cur_curlyx = NULL;
ST.B = next;
+ ST.prev_eval = cur_eval;
+ cur_eval = st;
+
DEBUG_EXECUTE_r(
debug_start_match(re, do_utf8, locinput, PL_regeol,
"Matching embedded");
);
- /* now continue from first node in postoned RE */
- PUSH_YES_STATE_GOTO(EVAL_A, re->program + 1);
+ /* now continue from first node in postoned RE */
+ PUSH_YES_STATE_GOTO(EVAL_AB, re->program + 1);
/* NOTREACHED */
}
/* /(?(?{...})X|Y)/ */
- st->sw = SvTRUE(ret);
+ st->sw = (bool)SvTRUE(ret);
st->logical = 0;
break;
}
- case EVAL_A: /* successfully ran inner rex (??{rex}) */
- if (ST.toggleutf)
- PL_reg_flags ^= RF_utf8;
+ case EVAL_AB: /* cleanup after a successful (??{A})B */
+ /* note: this is called twice; first after popping B, then A */
+ PL_reg_flags ^= ST.toggle_reg_flags;
ReREFCNT_dec(rex);
rex = ST.prev_rex;
+ regcpblow(ST.cp);
+ cur_eval = ST.prev_eval;
+ cur_curlyx = ST.prev_curlyx;
/* 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;
+ sayYES;
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
+ case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
+ /* note: this is called twice; first after popping B, then A */
+ PL_reg_flags ^= ST.toggle_reg_flags;
+ ReREFCNT_dec(rex);
+ rex = ST.prev_rex;
PL_reginput = locinput;
REGCP_UNWIND(ST.lastcp);
regcppop(rex);
+ cur_eval = ST.prev_eval;
+ cur_curlyx = ST.prev_curlyx;
+ /* XXXX This is too dramatic a measure... */
+ PL_reg_maxiter = 0;
sayNO_SILENT;
#undef ST
break;
case GROUPP:
n = ARG(scan); /* which paren pair */
- st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
+ st->sw = (bool)((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
break;
case IFTHEN:
PL_reg_leftiter = PL_reg_maxiter; /* Void cache */
st->logical = scan->flags;
break;
/*******************************************************************
- cc points to the regmatch_state associated with the most recent CURLYX.
+ cur_curlyx points to the regmatch_state associated with the most recent CURLYX.
This struct contains info about the innermost (...)* loop (an
- "infoblock"), and a pointer to the next outer cc.
+ "infoblock"), and a pointer to the next outer cur_curlyx.
Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
1) After matching Y, regnode for CURLYX is processed;
- 2) This regnode populates cc, and calls regmatch() recursively
+ 2) This regnode populates cur_curlyx, and calls regmatch() recursively
with the starting point at WHILEM node;
3) Each hit of WHILEM node tries to match A and Z (in the order
depending on the current iteration, min/max of {min,max} and
greediness). The information about where are nodes for "A"
- and "Z" is read from cc, as is info on how many times "A"
+ and "Z" is read from cur_curlyx, as is info on how many times "A"
was already matched, and greediness.
4) After A matches, the same WHILEM node is hit again.
- 5) Each time WHILEM is hit, cc is the infoblock created by CURLYX
+ 5) Each time WHILEM is hit, cur_curlyx is the infoblock created by CURLYX
of the same pair. Thus when WHILEM tries to match Z, it temporarily
- resets cc, since this Y(A)*Z can be a part of some other loop:
+ resets cur_curlyx, since this Y(A)*Z can be a part of some other loop:
as in (Y(A)*Z)*. If Z matches, the automaton will hit the WHILEM node
of the external loop.
- Currently present infoblocks form a tree with a stem formed by st->cc
+ Currently present infoblocks form a tree with a stem formed by cur_curlyx
and whatever it mentions via ->next, and additional attached trees
corresponding to temporarily unset infoblocks as in "5" above.
parenfloor = *PL_reglastparen; /* Pessimization... */
st->u.curlyx.cp = PL_savestack_ix;
- st->u.curlyx.outercc = st->cc;
- st->cc = st;
+ st->u.curlyx.outercc = cur_curlyx;
+ cur_curlyx = st;
/* these fields contain the state of the current curly.
* they are accessed by subsequent WHILEMs;
* cur and lastloc are also updated by WHILEM */
REGMATCH(PREVOPER(next), CURLYX); /* start on the WHILEM */
/*** all unsaved local vars undefined at this point */
regcpblow(st->u.curlyx.cp);
- st->cc = st->u.curlyx.outercc;
+ cur_curlyx = st->u.curlyx.outercc;
saySAME(result);
}
/* NOTREACHED */
/* Dave says:
- st->cc gets initialised by CURLYX ready for use by WHILEM.
- So again, unless somethings been corrupted, st->cc cannot
+ cur_curlyx gets initialised by CURLYX ready for use by WHILEM.
+ So again, unless somethings been corrupted, cur_curlyx cannot
be null at that point in WHILEM.
See http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2006-04/msg00556.html
So we'll assert that this is true:
*/
- assert(st->cc);
- st->u.whilem.lastloc = st->cc->u.curlyx.lastloc; /* Detection of 0-len. */
+ assert(cur_curlyx);
+ st->u.whilem.lastloc = cur_curlyx->u.curlyx.lastloc; /* Detection of 0-len. */
st->u.whilem.cache_offset = 0;
st->u.whilem.cache_bit = 0;
- n = st->cc->u.curlyx.cur + 1; /* how many we know we matched */
+ n = cur_curlyx->u.curlyx.cur + 1; /* how many we know we matched */
PL_reginput = locinput;
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s %ld out of %ld..%ld cc=%"UVxf"\n",
- REPORT_CODE_OFF+PL_regindent*2, "",
- (long)n, (long)st->cc->u.curlyx.min,
- (long)st->cc->u.curlyx.max, PTR2UV(st->cc))
+ REPORT_CODE_OFF+depth*2, "",
+ (long)n, (long)cur_curlyx->u.curlyx.min,
+ (long)cur_curlyx->u.curlyx.max,
+ PTR2UV(cur_curlyx))
);
/* If degenerate scan matches "", assume scan done. */
- if (locinput == st->cc->u.curlyx.lastloc && n >= st->cc->u.curlyx.min) {
- st->u.whilem.savecc = st->cc;
- st->cc = st->cc->u.curlyx.outercc;
- if (st->cc)
- st->ln = st->cc->u.curlyx.cur;
+ if (locinput == cur_curlyx->u.curlyx.lastloc && n >=
+ cur_curlyx->u.curlyx.min)
+ {
+ st->u.whilem.savecc = cur_curlyx;
+ cur_curlyx = cur_curlyx->u.curlyx.outercc;
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s empty match detected, try continuation...\n",
- REPORT_CODE_OFF+PL_regindent*2, "")
+ REPORT_CODE_OFF+depth*2, "")
);
REGMATCH(st->u.whilem.savecc->next, WHILEM1);
/*** all unsaved local vars undefined at this point */
- st->cc = st->u.whilem.savecc;
+ cur_curlyx = st->u.whilem.savecc;
if (result)
sayYES;
- if (st->cc->u.curlyx.outercc)
- st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
sayNO;
}
/* First just match a string of min scans. */
- if (n < st->cc->u.curlyx.min) {
- st->cc->u.curlyx.cur = n;
- st->cc->u.curlyx.lastloc = locinput;
- REGMATCH(st->cc->u.curlyx.scan, WHILEM2);
+ if (n < cur_curlyx->u.curlyx.min) {
+ cur_curlyx->u.curlyx.cur = n;
+ cur_curlyx->u.curlyx.lastloc = locinput;
+ REGMATCH(cur_curlyx->u.curlyx.scan, WHILEM2);
/*** all unsaved local vars undefined at this point */
if (result)
sayYES;
- st->cc->u.curlyx.cur = n - 1;
- st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
+ cur_curlyx->u.curlyx.cur = n - 1;
+ cur_curlyx->u.curlyx.lastloc = st->u.whilem.lastloc;
sayNO;
}
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s already tried at this position...\n",
- REPORT_CODE_OFF+PL_regindent*2, "")
+ REPORT_CODE_OFF+depth*2, "")
);
sayNO; /* cache records failure */
}
/* Prefer next over scan for minimal matching. */
- if (st->cc->minmod) {
- st->u.whilem.savecc = st->cc;
- st->cc = st->cc->u.curlyx.outercc;
- if (st->cc)
- st->ln = st->cc->u.curlyx.cur;
+ if (cur_curlyx->minmod) {
+ st->u.whilem.savecc = cur_curlyx;
+ cur_curlyx = cur_curlyx->u.curlyx.outercc;
st->u.whilem.cp = regcppush(st->u.whilem.savecc->u.curlyx.parenfloor);
REGCP_SET(st->u.whilem.lastcp);
REGMATCH(st->u.whilem.savecc->next, WHILEM3);
/*** all unsaved local vars undefined at this point */
- st->cc = st->u.whilem.savecc;
+ cur_curlyx = st->u.whilem.savecc;
if (result) {
regcpblow(st->u.whilem.cp);
sayYES; /* All done. */
}
REGCP_UNWIND(st->u.whilem.lastcp);
regcppop(rex);
- if (st->cc->u.curlyx.outercc)
- st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
- if (n >= st->cc->u.curlyx.max) { /* Maximum greed exceeded? */
+ if (n >= cur_curlyx->u.curlyx.max) { /* Maximum greed exceeded? */
if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
&& !(PL_reg_flags & RF_warned)) {
PL_reg_flags |= RF_warned;
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s trying longer...\n",
- REPORT_CODE_OFF+PL_regindent*2, "")
+ REPORT_CODE_OFF+depth*2, "")
);
/* Try scanning more and see if it helps. */
PL_reginput = locinput;
- st->cc->u.curlyx.cur = n;
- st->cc->u.curlyx.lastloc = locinput;
- st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
+ cur_curlyx->u.curlyx.cur = n;
+ cur_curlyx->u.curlyx.lastloc = locinput;
+ st->u.whilem.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
REGCP_SET(st->u.whilem.lastcp);
- REGMATCH(st->cc->u.curlyx.scan, WHILEM4);
+ REGMATCH(cur_curlyx->u.curlyx.scan, WHILEM4);
/*** all unsaved local vars undefined at this point */
if (result) {
regcpblow(st->u.whilem.cp);
}
REGCP_UNWIND(st->u.whilem.lastcp);
regcppop(rex);
- st->cc->u.curlyx.cur = n - 1;
- st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
+ cur_curlyx->u.curlyx.cur = n - 1;
+ cur_curlyx->u.curlyx.lastloc = st->u.whilem.lastloc;
CACHEsayNO;
}
/* Prefer scan over next for maximal matching. */
- if (n < st->cc->u.curlyx.max) { /* More greed allowed? */
- st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
- st->cc->u.curlyx.cur = n;
- st->cc->u.curlyx.lastloc = locinput;
+ if (n < cur_curlyx->u.curlyx.max) { /* More greed allowed? */
+ st->u.whilem.cp = regcppush(cur_curlyx->u.curlyx.parenfloor);
+ cur_curlyx->u.curlyx.cur = n;
+ cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(st->u.whilem.lastcp);
- REGMATCH(st->cc->u.curlyx.scan, WHILEM5);
+ REGMATCH(cur_curlyx->u.curlyx.scan, WHILEM5);
/*** all unsaved local vars undefined at this point */
if (result) {
regcpblow(st->u.whilem.cp);
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s failed, try continuation...\n",
- REPORT_CODE_OFF+PL_regindent*2, "")
+ REPORT_CODE_OFF+depth*2, "")
);
}
if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
}
/* Failed deeper matches of scan, so see if this one works. */
- st->u.whilem.savecc = st->cc;
- st->cc = st->cc->u.curlyx.outercc;
- if (st->cc)
- st->ln = st->cc->u.curlyx.cur;
+ st->u.whilem.savecc = cur_curlyx;
+ cur_curlyx = cur_curlyx->u.curlyx.outercc;
REGMATCH(st->u.whilem.savecc->next, WHILEM6);
/*** all unsaved local vars undefined at this point */
- st->cc = st->u.whilem.savecc;
+ cur_curlyx = st->u.whilem.savecc;
if (result)
sayYES;
- if (st->cc->u.curlyx.outercc)
- st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
- st->cc->u.curlyx.cur = n - 1;
- st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
+ cur_curlyx->u.curlyx.cur = n - 1;
+ cur_curlyx->u.curlyx.lastloc = st->u.whilem.lastloc;
CACHEsayNO;
}
/* NOTREACHED */
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
- (int)(REPORT_CODE_OFF+(PL_regindent*2)), "",
+ (int)(REPORT_CODE_OFF+(depth*2)), "",
(IV) ST.count, (IV)ST.alen)
);
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s CURLYM trying tail with matches=%"IVdf"...\n",
- (int)(REPORT_CODE_OFF+(PL_regindent*2)),
+ (int)(REPORT_CODE_OFF+(depth*2)),
"", (IV)ST.count)
);
if (ST.c1 != CHRTEST_VOID
case END:
+ if (cur_eval) {
+ /* we've just finished A in /(??{A})B/; now continue with B */
+ I32 tmpix;
+
+
+ st->u.eval.toggle_reg_flags
+ = cur_eval->u.eval.toggle_reg_flags;
+ PL_reg_flags ^= st->u.eval.toggle_reg_flags;
+
+ st->u.eval.prev_rex = rex; /* inner */
+ rex = cur_eval->u.eval.prev_rex; /* outer */
+ cur_curlyx = cur_eval->u.eval.prev_curlyx;
+ ReREFCNT_inc(rex);
+ st->u.eval.cp = regcppush(0); /* Save *all* the positions. */
+ REGCP_SET(st->u.eval.lastcp);
+ PL_reginput = locinput;
+
+ /* Restore parens of the outer rex without popping the
+ * savestack */
+ tmpix = PL_savestack_ix;
+ PL_savestack_ix = cur_eval->u.eval.lastcp;
+ regcppop(rex);
+ PL_savestack_ix = tmpix;
+
+ st->u.eval.prev_eval = cur_eval;
+ cur_eval = cur_eval->u.eval.prev_eval;
+ DEBUG_EXECUTE_r(
+ PerlIO_printf(Perl_debug_log, "%*s EVAL trying tail ...\n",
+ REPORT_CODE_OFF+depth*2, ""););
+ PUSH_YES_STATE_GOTO(EVAL_AB,
+ st->u.eval.prev_eval->u.eval.B); /* match B */
+ }
+
if (locinput < reginfo->till) {
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
"%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
(long)(locinput - PL_reg_starttry),
(long)(reginfo->till - PL_reg_starttry),
PL_colors[5]));
- sayNO_FINAL; /* Cannot match: too short. */
+ sayNO_SILENT; /* Cannot match: too short. */
}
PL_reginput = locinput; /* put where regtry can find it */
- sayYES_FINAL; /* Success! */
+ sayYES; /* Success! */
case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s %ssubpattern success...%s\n",
- REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5]));
+ REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]));
PL_reginput = locinput; /* put where regtry can find it */
- sayYES_FINAL; /* Success! */
+ sayYES; /* Success! */
#undef ST
#define ST st->u.ifmatch
{
regmatch_state *newst;
+ DEBUG_STATE_pp("push");
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;
/* push new state */
regmatch_state *oldst = st;
+ DEBUG_STATE_pp("push");
depth++;
- DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "PUSH RECURSE STATE(%d)\n", depth));
+ st->u.yes.prev_yes_state = yes_state;
+ yes_state = st;
/* grab the next free state slot */
st++;
oldst->n = n;
oldst->locinput = locinput;
- st->cc = oldst->cc;
locinput = PL_reginput;
nextchr = UCHARAT(locinput);
st->minmod = 0;
st->sw = 0;
st->logical = 0;
-#ifdef DEBUGGING
- PL_regindent++;
-#endif
}
}
-
-
/*
* We get here only if there's trouble -- normally "case END" is
* the terminating point.
/*NOTREACHED*/
sayNO;
-yes_final:
-
+yes:
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 */
assert(st != yes_state);
+#ifdef DEBUGGING
+ while (st != yes_state) {
+ st--;
+ if (st < SLAB_FIRST(PL_regmatch_slab)) {
+ PL_regmatch_slab = PL_regmatch_slab->prev;
+ st = SLAB_LAST(PL_regmatch_slab);
+ }
+ DEBUG_STATE_pp("pop (yes)");
+ depth--;
+ }
+#else
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_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATES (%"UVuf"..%"UVuf")\n",
- (UV)(depth+1), (UV)(depth+(st - yes_state))));
+#endif
st = yes_state;
yes_state = st->u.yes.prev_yes_state;
PL_regmatch_state = st;
switch (st->resume_state) {
- case EVAL_A:
+ case resume_CURLYX:
+ case resume_WHILEM1:
+ case resume_WHILEM2:
+ case resume_WHILEM3:
+ case resume_WHILEM4:
+ case resume_WHILEM5:
+ case resume_WHILEM6:
+ result = 1;
+ /* restore previous state and re-enter */
+ 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_WHILEM1;
+ case resume_WHILEM2:
+ goto resume_point_WHILEM2;
+ case resume_WHILEM3:
+ goto resume_point_WHILEM3;
+ case resume_WHILEM4:
+ goto resume_point_WHILEM4;
+ case resume_WHILEM5:
+ goto resume_point_WHILEM5;
+ case resume_WHILEM6:
+ goto resume_point_WHILEM6;
+ }
+ Perl_croak(aTHX_ "unexpected whilem resume state");
+
+ case EVAL_AB:
case IFMATCH_A:
case CURLYM_A:
state_num = st->resume_state;
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
PL_colors[4], PL_colors[5]));
-yes:
-#ifdef DEBUGGING
- PL_regindent--;
-#endif
result = 1;
- /* XXX this is duplicate(ish) code to that in the do_no section.
- * will disappear when REGFMATCH goes */
- if (depth) {
- /* restore previous state and re-enter */
- 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_WHILEM1;
- case resume_WHILEM2:
- goto resume_point_WHILEM2;
- case resume_WHILEM3:
- goto resume_point_WHILEM3;
- case resume_WHILEM4:
- goto resume_point_WHILEM4;
- case resume_WHILEM5:
- goto resume_point_WHILEM5;
- case resume_WHILEM6:
- goto resume_point_WHILEM6;
-
- 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");
- }
- }
goto final_exit;
no:
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
"%*s %sfailed...%s\n",
- REPORT_CODE_OFF+PL_regindent*2, "",
+ REPORT_CODE_OFF+depth*2, "",
PL_colors[4], PL_colors[5])
);
-no_final:
-do_no:
-#ifdef DEBUGGING
- PL_regindent--;
-#endif
+no_silent:
result = 0;
if (depth) {
/* there's a previous state to backtrack to */
- 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;
locinput= st->locinput;
nextchr = UCHARAT(locinput);
+ DEBUG_STATE_pp("pop");
+ depth--;
+ if (yes_state == st)
+ yes_state = st->u.yes.prev_yes_state;
+
switch (st->resume_state) {
case resume_CURLYX:
goto resume_point_CURLYX;
goto resume_point_WHILEM6;
case TRIE_next:
- case EVAL_A:
+ case EVAL_AB:
case BRANCH_next:
case CURLYM_A:
case CURLYM_B:
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;
}
}
-final_exit:
+ final_exit:
/* restore original high-water mark */
PL_regmatch_slab = orig_slab;
}
return result;
-
}
/*
return s;
}
+#ifdef XXX_dmq
+/* there are a bunch of places where we use two reghop3's that should
+ be replaced with this routine. but since thats not done yet
+ we ifdef it out - dmq
+*/
STATIC U8 *
S_reghop4(U8 *s, I32 off, const U8* llim, const U8* rlim)
{
}
return s;
}
-
+#endif
STATIC U8 *
S_reghopmaybe3(U8* s, I32 off, const U8* lim)
https://perl5.git.perl.org / perl5.git / blobdiff