(IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
STATIC char *
-S_regcppop(pTHX)
+S_regcppop(pTHX_ const regexp *rex)
{
dVAR;
I32 i;
- U32 paren = 0;
char *input;
GET_RE_DEBUG_FLAGS_DECL;
for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
i > 0; i -= REGCP_PAREN_ELEMS) {
I32 tmps;
- paren = (U32)SSPOPINT;
+ U32 paren = (U32)SSPOPINT;
PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
PL_regstartp[paren] = SSPOPINT;
tmps = SSPOPINT;
);
}
DEBUG_EXECUTE_r(
- if ((I32)(*PL_reglastparen + 1) <= PL_regnpar) {
+ if ((I32)(*PL_reglastparen + 1) <= rex->nparens) {
PerlIO_printf(Perl_debug_log,
" restoring \\%"IVdf"..\\%"IVdf" to undef\n",
- (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
+ (IV)(*PL_reglastparen + 1), (IV)rex->nparens);
}
);
#if 1
* building DynaLoader will fail:
* "Error: '*' not in typemap in DynaLoader.xs, line 164"
* --jhi */
- for (paren = *PL_reglastparen + 1; (I32)paren <= PL_regnpar; paren++) {
- if ((I32)paren > PL_regsize)
- PL_regstartp[paren] = -1;
- PL_regendp[paren] = -1;
+ for (i = *PL_reglastparen + 1; i <= rex->nparens; i++) {
+ if (i > PL_regsize)
+ PL_regstartp[i] = -1;
+ PL_regendp[i] = -1;
}
#endif
return input;
nosave ? 0 : REXEC_COPY_STR);
}
-STATIC void
-S_cache_re(pTHX_ regexp *prog)
-{
- dVAR;
- PL_regprecomp = prog->precomp; /* Needed for FAIL. */
-#ifdef DEBUGGING
- PL_regprogram = prog->program;
-#endif
- PL_regnpar = prog->nparens;
- PL_regdata = prog->data;
- PL_reg_re = prog;
-}
/*
* Need to implement the following flags for reg_anch:
: strend);
t = s;
- cache_re(prog);
+ PL_reg_re = prog;
s = find_byclass(prog, prog->regstclass, s, endpos, 1);
if (!s) {
#ifdef DEBUGGING
/* We know what class REx starts with. Try to find this position... */
STATIC char *
-S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun)
+S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char *strend, I32 norun)
{
dVAR;
const I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
PERL_UNUSED_ARG(data);
RX_MATCH_UTF8_set(prog,do_utf8);
- cache_re(prog);
+ PL_reg_re = prog;
#ifdef DEBUGGING
PL_regnarrate = DEBUG_r_TEST;
#endif
sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
restored, the value remains
the same. */
- restore_pos(aTHX_ 0);
+ restore_pos(aTHX_ prog);
}
/* make sure $`, $&, $', and $digit will work later */
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
PL_colors[4], PL_colors[5]));
if (PL_reg_eval_set)
- restore_pos(aTHX_ 0);
+ restore_pos(aTHX_ prog);
return 0;
}
S_regtry(pTHX_ regexp *prog, char *startpos)
{
dVAR;
- register I32 i;
register I32 *sp;
register I32 *ep;
CHECKPOINT lastcp;
}
PL_reg_magic = mg;
PL_reg_oldpos = mg->mg_len;
- SAVEDESTRUCTOR_X(restore_pos, 0);
+ SAVEDESTRUCTOR_X(restore_pos, prog);
}
if (!PL_reg_curpm) {
Newxz(PL_reg_curpm, 1, PMOP);
sp = prog->startp;
ep = prog->endp;
if (prog->nparens) {
+ register I32 i;
for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
*++sp = -1;
*++ep = -1;
}
#endif
REGCP_SET(lastcp);
- if (regmatch(prog->program + 1)) {
+ if (regmatch(prog, prog->program + 1)) {
prog->endp[0] = PL_reginput - PL_bostr;
return 1;
}
STATIC I32 /* 0 failure, 1 success */
-S_regmatch(pTHX_ regnode *prog)
+S_regmatch(pTHX_ regexp *rex, regnode *prog)
{
dVAR;
register const bool do_utf8 = PL_reg_match_utf8;
PL_colors[1],
15 - l - pref_len + 1,
"",
- (IV)(scan - PL_regprogram), PL_regindent*2, "",
+ (IV)(scan - rex->program), PL_regindent*2, "",
SvPVX_const(prop));
}
});
/* what trie are we using right now */
reg_trie_data *trie
- = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
+ = (reg_trie_data*)PL_reg_re->data->data[ ARG( scan ) ];
st->u.trie.accepted = 0; /* how many accepting states we have seen */
result = 0;
if ( st->u.trie.accepted == 1 ) {
DEBUG_EXECUTE_r({
- SV **tmp = av_fetch( trie->words, st->u.trie.accept_buff[ 0 ].wordnum-1, 0 );
+ 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],
best = cur;
}
DEBUG_EXECUTE_r({
+ reg_trie_data * const trie = (reg_trie_data*)
+ PL_reg_re->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 0x%p%s\n",
REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
break;
case EVAL:
{
- dSP;
- OP_4tree * const oop = PL_op;
- COP * const ocurcop = PL_curcop;
- PAD *old_comppad;
SV *ret;
- struct regexp * const oreg = PL_reg_re;
-
- n = ARG(scan);
- PL_op = (OP_4tree*)PL_regdata->data[n];
- DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
- PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
- PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
-
{
+ /* execute the code in the {...} */
+ dSP;
SV ** const before = SP;
+ OP_4tree * const oop = PL_op;
+ COP * const ocurcop = PL_curcop;
+ PAD *old_comppad;
+ struct regexp * const oreg = PL_reg_re;
+
+ n = ARG(scan);
+ PL_op = (OP_4tree*)PL_reg_re->data->data[n];
+ DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
+ PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_reg_re->data->data[n + 2]);
+ PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
+
CALLRUNOPS(aTHX); /* Scalar context. */
SPAGAIN;
if (SP == before)
ret = POPs;
PUTBACK;
}
+
+ PL_op = oop;
+ PAD_RESTORE_LOCAL(old_comppad);
+ PL_curcop = ocurcop;
+ PL_reg_re = oreg;
+ if (!st->logical) {
+ /* /(?{...})/ */
+ sv_setsv(save_scalar(PL_replgv), ret);
+ break;
+ }
}
+ if (st->logical == 2) { /* Postponed subexpression: /(??{...})/ */
+ regexp *re;
+ re_cc_state state;
+ int toggleutf;
- PL_op = oop;
- PAD_RESTORE_LOCAL(old_comppad);
- PL_curcop = ocurcop;
- if (st->logical) {
- if (st->logical == 2) { /* Postponed subexpression. */
- regexp *re;
- MAGIC *mg = NULL;
- re_cc_state state;
- int toggleutf;
- register SV *sv;
+ {
+ /* extract RE object from returned value; compiling if
+ * necessary */
+ MAGIC *mg = NULL;
+ SV *sv;
if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
mg = mg_find(sv, PERL_MAGIC_qr);
else if (SvSMAGICAL(ret)) {
STRLEN len;
const char * const t = SvPV_const(ret, len);
PMOP pm;
- char * const oprecomp = PL_regprecomp;
const I32 osize = PL_regsize;
- const I32 onpar = PL_regnpar;
Zero(&pm, 1, PMOP);
- if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
+ if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
if (!(SvFLAGS(ret)
& (SVs_TEMP | SVs_PADTMP | SVf_READONLY
| SVs_GMG)))
sv_magic(ret,(SV*)ReREFCNT_inc(re),
PERL_MAGIC_qr,0,0);
- PL_regprecomp = oprecomp;
PL_regsize = osize;
- PL_regnpar = onpar;
}
- 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 ? "..." : ""))
- );
- state.node = next;
- state.prev = PL_reg_call_cc;
- state.cc = st->cc;
- state.re = PL_reg_re;
+ }
+ 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 ? "..." : ""))
+ );
+ state.node = next;
+ state.prev = PL_reg_call_cc;
+ state.cc = st->cc;
+ state.re = PL_reg_re;
- st->cc = 0;
-
- st->u.eval.cp = regcppush(0); /* Save *all* the positions. */
- REGCP_SET(st->u.eval.lastcp);
- cache_re(re);
- state.ss = PL_savestack_ix;
- *PL_reglastparen = 0;
- *PL_reglastcloseparen = 0;
- PL_reg_call_cc = &state;
- PL_reginput = locinput;
- toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
- ((re->reganch & ROPT_UTF8) != 0);
- if (toggleutf) PL_reg_flags ^= RF_utf8;
+ st->cc = 0;
+
+ st->u.eval.cp = regcppush(0); /* Save *all* the positions. */
+ REGCP_SET(st->u.eval.lastcp);
+ PL_reg_re = re;
+ state.ss = PL_savestack_ix;
+ *PL_reglastparen = 0;
+ *PL_reglastcloseparen = 0;
+ PL_reg_call_cc = &state;
+ PL_reginput = locinput;
+ toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
+ ((re->reganch & ROPT_UTF8) != 0);
+ if (toggleutf) PL_reg_flags ^= RF_utf8;
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
+ /* XXXX This is too dramatic a measure... */
+ PL_reg_maxiter = 0;
- /* XXX the only recursion left in regmatch() */
- if (regmatch(re->program + 1)) {
- /* Even though we succeeded, we need to restore
- global variables, since we may be wrapped inside
- SUSPEND, thus the match may be not finished yet. */
-
- /* XXXX Do this only if SUSPENDed? */
- PL_reg_call_cc = state.prev;
- st->cc = state.cc;
- PL_reg_re = state.re;
- cache_re(PL_reg_re);
- if (toggleutf) PL_reg_flags ^= RF_utf8;
-
- /* XXXX This is too dramatic a measure... */
- PL_reg_maxiter = 0;
-
- /* These are needed even if not SUSPEND. */
- ReREFCNT_dec(re);
- regcpblow(st->u.eval.cp);
- sayYES;
- }
- ReREFCNT_dec(re);
- REGCP_UNWIND(st->u.eval.lastcp);
- regcppop();
+ /* XXX the only recursion left in regmatch() */
+ if (regmatch(re, re->program + 1)) {
+ /* Even though we succeeded, we need to restore
+ global variables, since we may be wrapped inside
+ SUSPEND, thus the match may be not finished yet. */
+
+ /* XXXX Do this only if SUSPENDed? */
PL_reg_call_cc = state.prev;
st->cc = state.cc;
PL_reg_re = state.re;
- cache_re(PL_reg_re);
+
if (toggleutf) PL_reg_flags ^= RF_utf8;
/* XXXX This is too dramatic a measure... */
PL_reg_maxiter = 0;
- st->logical = 0;
- sayNO;
+ /* These are needed even if not SUSPEND. */
+ ReREFCNT_dec(re);
+ regcpblow(st->u.eval.cp);
+ sayYES;
}
- st->sw = SvTRUE(ret);
+ ReREFCNT_dec(re);
+ REGCP_UNWIND(st->u.eval.lastcp);
+ regcppop(rex);
+ PL_reg_call_cc = state.prev;
+ st->cc = state.cc;
+ PL_reg_re = state.re;
+ if (toggleutf) PL_reg_flags ^= RF_utf8;
+
+ /* XXXX This is too dramatic a measure... */
+ PL_reg_maxiter = 0;
+
st->logical = 0;
+ sayNO;
+ /* NOTREACHED */
}
- else {
- sv_setsv(save_scalar(PL_replgv), ret);
- cache_re(oreg);
- }
+ /* /(?(?{...})X|Y)/ */
+ st->sw = SvTRUE(ret);
+ st->logical = 0;
break;
}
case OPEN:
CACHEsayYES; /* All done. */
}
REGCP_UNWIND(st->u.whilem.lastcp);
- regcppop();
+ regcppop(rex);
if (st->cc->u.curlyx.outercc)
st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
CACHEsayYES;
}
REGCP_UNWIND(st->u.whilem.lastcp);
- regcppop();
+ regcppop(rex);
st->cc->u.curlyx.cur = n - 1;
st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
CACHEsayNO;
CACHEsayYES;
}
REGCP_UNWIND(st->u.whilem.lastcp);
- regcppop(); /* Restore some previous $<digit>s? */
+ regcppop(rex); /* Restore some previous $<digit>s? */
PL_reginput = locinput;
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
{
I32 tmp = PL_savestack_ix;
PL_savestack_ix = PL_reg_call_cc->ss;
- regcppop();
+ regcppop(rex);
PL_savestack_ix = tmp;
}
/* Make position available to the callcc. */
PL_reginput = locinput;
- cache_re(PL_reg_call_cc->re);
+ PL_reg_re = PL_reg_call_cc->re;
st->u.end.savecc = st->cc;
st->cc = PL_reg_call_cc->cc;
PL_reg_call_cc = PL_reg_call_cc->prev;
sayYES;
}
REGCP_UNWIND(st->u.end.lastcp);
- regcppop();
+ regcppop(rex);
PL_reg_call_cc = st->u.end.cur_call_cc;
st->cc = st->u.end.savecc;
PL_reg_re = st->u.end.end_re;
- cache_re(st->u.end.end_re);
DEBUG_EXECUTE_r(
PerlIO_printf(Perl_debug_log,
while (sl) {
osl = sl;
sl = sl->next;
+ Safefree(osl);
}
}
if (max == REG_INFTY)
max = I32_MAX;
else if (max < loceol - scan)
- loceol = scan + max;
+ loceol = scan + max;
switch (OP(p)) {
case REG_ANY:
if (do_utf8) {
SV *sw = NULL;
SV *si = NULL;
SV *alt = NULL;
+ const struct reg_data *data = PL_reg_re ? PL_reg_re->data : NULL;
- if (PL_regdata && PL_regdata->count) {
+ if (data && data->count) {
const U32 n = ARG(node);
- if (PL_regdata->what[n] == 's') {
- SV * const rv = (SV*)PL_regdata->data[n];
+ if (data->what[n] == 's') {
+ SV * const rv = (SV*)data->data[n];
AV * const av = (AV*)SvRV((SV*)rv);
SV **const ary = AvARRAY(av);
SV **a, **b;
restore_pos(pTHX_ void *arg)
{
dVAR;
- PERL_UNUSED_ARG(arg);
+ regexp * const rex = (regexp *)arg;
if (PL_reg_eval_set) {
if (PL_reg_oldsaved) {
- PL_reg_re->subbeg = PL_reg_oldsaved;
- PL_reg_re->sublen = PL_reg_oldsavedlen;
+ rex->subbeg = PL_reg_oldsaved;
+ rex->sublen = PL_reg_oldsavedlen;
#ifdef PERL_OLD_COPY_ON_WRITE
- PL_reg_re->saved_copy = PL_nrs;
+ rex->saved_copy = PL_nrs;
#endif
- RX_MATCH_COPIED_on(PL_reg_re);
+ RX_MATCH_COPIED_on(rex);
}
PL_reg_magic->mg_len = PL_reg_oldpos;
PL_reg_eval_set = 0;
S_to_utf8_substr(pTHX_ register regexp *prog)
{
if (prog->float_substr && !prog->float_utf8) {
- SV* sv;
- prog->float_utf8 = sv = newSVsv(prog->float_substr);
+ SV* const sv = newSVsv(prog->float_substr);
+ prog->float_utf8 = sv;
sv_utf8_upgrade(sv);
if (SvTAIL(prog->float_substr))
SvTAIL_on(sv);
prog->check_utf8 = sv;
}
if (prog->anchored_substr && !prog->anchored_utf8) {
- SV* sv;
- prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr);
+ SV* const sv = newSVsv(prog->anchored_substr);
+ prog->anchored_utf8 = sv;
sv_utf8_upgrade(sv);
if (SvTAIL(prog->anchored_substr))
SvTAIL_on(sv);
{
dVAR;
if (prog->float_utf8 && !prog->float_substr) {
- SV* sv;
- prog->float_substr = sv = newSVsv(prog->float_utf8);
+ SV* sv = newSVsv(prog->float_utf8);
+ prog->float_substr = sv;
if (sv_utf8_downgrade(sv, TRUE)) {
if (SvTAIL(prog->float_utf8))
SvTAIL_on(sv);
prog->check_substr = sv;
}
if (prog->anchored_utf8 && !prog->anchored_substr) {
- SV* sv;
- prog->anchored_substr = sv = newSVsv(prog->anchored_utf8);
+ SV* sv = newSVsv(prog->anchored_utf8);
+ prog->anchored_substr = sv;
if (sv_utf8_downgrade(sv, TRUE)) {
if (SvTAIL(prog->anchored_utf8))
SvTAIL_on(sv);
projects / p5sagit/p5-mst-13.2.git / blobdiff