# define Perl_pregfree my_regfree
# define Perl_re_intuit_string my_re_intuit_string
/* *These* symbols are masked to allow static link. */
-# define Perl_regnext my_regnext
-# define Perl_save_re_context my_save_re_context
-# define Perl_reginitcolors my_reginitcolors
# define PERL_NO_GET_CONTEXT
#endif
/* Peephole optimizer: */
DEBUG_OPTIMISE_r({
SV * const mysv=sv_newmortal();
- regprop( mysv, scan);
+ regprop(RExC_rx, mysv, scan);
PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n",
(int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan));
});
}
DEBUG_OPTIMISE_r({
- regprop( mysv, tail );
+ regprop(RExC_rx, mysv, tail );
PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
(int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen_const( mysv ),
(RExC_seen_evals) ? "[EVAL]" : ""
regnode * const noper_next = regnext( noper );
DEBUG_OPTIMISE_r({
- regprop( mysv, cur);
+ regprop(RExC_rx, mysv, cur);
PerlIO_printf( Perl_debug_log, "%*s%s",
(int)depth * 2 + 2," ", SvPV_nolen_const( mysv ) );
- regprop( mysv, noper);
+ regprop(RExC_rx, mysv, noper);
PerlIO_printf( Perl_debug_log, " -> %s",
SvPV_nolen_const(mysv));
if ( noper_next ) {
- regprop( mysv, noper_next );
+ regprop(RExC_rx, mysv, noper_next );
PerlIO_printf( Perl_debug_log,"\t=> %s\t",
SvPV_nolen_const(mysv));
}
} else {
DEBUG_OPTIMISE_r(
if (!last ) {
- regprop( mysv, first);
+ regprop(RExC_rx, mysv, first);
PerlIO_printf( Perl_debug_log, "%*s%s",
(int)depth * 2 + 2, "F:", SvPV_nolen_const( mysv ) );
- regprop( mysv, NEXTOPER(first) );
+ regprop(RExC_rx, mysv, NEXTOPER(first) );
PerlIO_printf( Perl_debug_log, " -> %s\n",
SvPV_nolen_const( mysv ) );
}
);
last = cur;
DEBUG_OPTIMISE_r({
- regprop( mysv, cur);
+ regprop(RExC_rx, mysv, cur);
PerlIO_printf( Perl_debug_log, "%*s%s",
(int)depth * 2 + 2, "N:", SvPV_nolen_const( mysv ) );
- regprop( mysv, noper );
+ regprop(RExC_rx, mysv, noper );
PerlIO_printf( Perl_debug_log, " -> %s\n",
SvPV_nolen_const( mysv ) );
});
}
}
DEBUG_OPTIMISE_r({
- regprop( mysv, cur);
+ regprop(RExC_rx, mysv, cur);
PerlIO_printf( Perl_debug_log,
"%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
" ", SvPV_nolen_const( mysv ), first, last, cur);
UV uc = *((U8*)STRING(scan));
/* Search for fixed substrings supports EXACT only. */
- if (flags & SCF_DO_SUBSTR)
+ if (flags & SCF_DO_SUBSTR) {
+ assert(data);
scan_commit(pRExC_state, data);
+ }
if (UTF) {
const U8 * const s = (U8 *)STRING(scan);
l = utf8_length(s, s + l);
uc = utf8_to_uvchr(s, NULL);
}
min += l;
- if (data && (flags & SCF_DO_SUBSTR))
+ if (flags & SCF_DO_SUBSTR)
data->pos_min += l;
if (flags & SCF_DO_STCLASS_AND) {
/* Check whether it is compatible with what we know already! */
return RExC_rx->data->count - n;
}
+#ifndef PERL_IN_XSUB_RE
void
Perl_reginitcolors(pTHX)
{
}
PL_colorset = 1;
}
-
+#endif
/*
- pregcomp - compile a regular expression into internal code
r->regstclass = (regnode*)RExC_rx->data->data[n];
r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
- regprop(sv, (regnode*)data.start_class);
+ regprop(r, sv, (regnode*)data.start_class);
PerlIO_printf(Perl_debug_log,
"synthetic stclass \"%s\".\n",
SvPVX_const(sv));});
r->regstclass = (regnode*)RExC_rx->data->data[n];
r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */
DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
- regprop(sv, (regnode*)data.start_class);
+ regprop(r, sv, (regnode*)data.start_class);
PerlIO_printf(Perl_debug_log,
"synthetic stclass \"%s\".\n",
SvPVX_const(sv));});
ANYOF_FLAGS(ret) |= ANYOF_INVERT;
}
- if (SIZE_ONLY)
+ if (SIZE_ONLY) {
RExC_size += ANYOF_SKIP;
+ listsv = &PL_sv_undef; /* For code scanners: listsv always non-NULL. */
+ }
else {
RExC_emit += ANYOF_SKIP;
if (FOLD)
PerlIO_printf(Perl_debug_log, ") ");
if (r->regstclass) {
- regprop(sv, r->regstclass);
+ regprop(r, sv, r->regstclass);
PerlIO_printf(Perl_debug_log, "stclass \"%s\" ", SvPVX_const(sv));
}
if (r->reganch & ROPT_ANCH) {
- regprop - printable representation of opcode
*/
void
-Perl_regprop(pTHX_ SV *sv, const regnode *o)
+Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
{
#ifdef DEBUGGING
dVAR;
{
SV *lv;
- SV * const sw = regclass_swash(o, FALSE, &lv, 0);
+ SV * const sw = regclass_swash(prog, o, FALSE, &lv, 0);
if (lv) {
if (sw) {
dVAR;
#ifdef DEBUGGING
SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
- SV * const re_debug_flags=get_sv(RE_DEBUG_FLAGS,0);
#endif
-
+ GET_RE_DEBUG_FLAGS_DECL;
if (!r || (--r->refcnt > 0))
return;
Safefree(r);
}
+#ifndef PERL_IN_XSUB_RE
/*
- regnext - dig the "next" pointer out of a node
*/
return(p+offset);
}
+#endif
STATIC void
S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
/* XXX Here's a total kludge. But we need to re-enter for swash routines. */
+#ifndef PERL_IN_XSUB_RE
void
Perl_save_re_context(pTHX)
{
}
}
}
+#endif
static void
clear_re(pTHX_ void *r)
}
-STATIC regnode *
-S_dumpuntil(pTHX_ const regexp *r, regnode *start, regnode *node, regnode *last,
- SV* sv, I32 l)
+STATIC const regnode *
+S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
+ const regnode *last, SV* sv, I32 l)
{
dVAR;
register U8 op = EXACT; /* Arbitrary non-END op. */
- register regnode *next;
+ register const regnode *next;
while (op != END && (!last || node < last)) {
/* While that wasn't END last time... */
op = OP(node);
if (op == CLOSE)
l--;
- next = regnext(node);
+ next = regnext((regnode *)node);
/* Where, what. */
if (OP(node) == OPTIMIZED)
goto after_print;
- regprop(sv, node);
+ regprop(r, sv, node);
PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start),
(int)(2*l + 1), "", SvPVX_const(sv));
if (next == NULL) /* Next ptr. */
(void)PerlIO_putc(Perl_debug_log, '\n');
after_print:
if (PL_regkind[(U8)op] == BRANCHJ) {
- register regnode *nnode = (OP(next) == LONGJMP
- ? regnext(next)
- : next);
+ register const regnode *nnode = (OP(next) == LONGJMP
+ ? regnext((regnode *)next)
+ : next);
if (last && nnode > last)
nnode = last;
node = dumpuntil(r, start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);