#define RExC_starttry (pRExC_state->starttry)
#endif
#ifdef DEBUGGING
- char *lastparse;
+ const char *lastparse;
I32 lastnum;
#define RExC_lastparse (pRExC_state->lastparse)
#define RExC_lastnum (pRExC_state->lastnum)
"Match","Base","Ofs" );
for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
- SV **tmp = av_fetch( trie->revcharmap, state, 0);
+ SV ** const tmp = av_fetch( trie->revcharmap, state, 0);
if ( tmp ) {
PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
}
PerlIO_printf( Perl_debug_log, "\n");
for( state = 1 ; state < TRIE_LASTSTATE(trie) ; state++ ) {
- const U32 base = trie->states[ state ].trans.base;
+ const U32 base = trie->states[ state ].trans.base;
PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
);
}
for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
- SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
+ SV ** const tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
PerlIO_printf( Perl_debug_log, "%s:%3X=%4"UVXf" | ",
SvPV_nolen_const( *tmp ),
TRIE_LIST_ITEM(state,charid).forid,
PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
- SV **tmp = av_fetch( trie->revcharmap, charid, 0);
+ SV ** const tmp = av_fetch( trie->revcharmap, charid, 0);
if ( tmp ) {
PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
}
/* add a fail transition */
reg_trie_data *trie=(reg_trie_data *)RExC_rx->data->data[ARG(source)];
U32 *q;
- U32 ucharcount = trie->uniquecharcount;
- U32 numstates = trie->laststate;
- U32 ubound = trie->lasttrans + ucharcount;
+ const U32 ucharcount = trie->uniquecharcount;
+ const U32 numstates = trie->laststate;
+ const U32 ubound = trie->lasttrans + ucharcount;
U32 q_read = 0;
U32 q_write = 0;
U32 charid;
U32 base = trie->states[ 1 ].trans.base;
- U32 newstate;
U32 *fail;
reg_ac_data *aho;
const U32 data_slot = add_data( pRExC_state, 1, "T" );
GET_RE_DEBUG_FLAGS_DECL;
+#ifndef DEBUGGING
+ PERL_UNUSED_ARG(depth);
+#endif
+
ARG_SET( stclass, data_slot );
Newxz( aho, 1, reg_ac_data );
(trie->laststate+1)*sizeof(reg_trie_state));
Newxz( q, numstates, U32);
Newxz( aho->fail, numstates, U32 );
- fail= aho->fail;
+ aho->refcount = 1;
+ fail = aho->fail;
fail[ 0 ] = fail[ 1 ] = 1;
for ( charid = 0; charid < ucharcount ; charid++ ) {
- newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
- if ( newstate )
- {
+ const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 );
+ if ( newstate ) {
q[ q_write ] = newstate;
/* set to point at the root */
fail[ q[ q_write++ ] ]=1;
}
}
while ( q_read < q_write) {
- U32 cur = q[ q_read++ % numstates ];
- U32 ch_state;
+ const U32 cur = q[ q_read++ % numstates ];
base = trie->states[ cur ].trans.base;
for ( charid = 0 ; charid < ucharcount ; charid++ ) {
- if ( ( ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 ) ) ) {
+ const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 );
+ if (ch_state) {
U32 fail_state = cur;
U32 fail_base;
do {
AV *trie_revcharmap;
#endif
GET_RE_DEBUG_FLAGS_DECL;
+#ifndef DEBUGGING
+ PERL_UNUSED_ARG(depth);
+#endif
Newxz( trie, 1, reg_trie_data );
trie->refcount = 1;
PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
(int)depth * 2 + 2,"",
( trie->widecharmap ? "UTF8" : "NATIVE" ), TRIE_WORDCOUNT(trie),
- (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, trie->minlen, trie->maxlen )
+ (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
+ (int)trie->minlen, (int)trie->maxlen )
);
Newxz( trie->wordlen, TRIE_WORDCOUNT(trie), U32 );
"%*sNew Start State=%"UVuf" Class: [",
(int)depth * 2 + 2, "",
state));
- if (idx>-1) {
- SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
- const U8 *ch = (U8*)SvPV_nolen_const( *tmp );
+ if (idx >= 0) {
+ SV ** const tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0);
+ const U8 * const ch = (U8*)SvPV_nolen_const( *tmp );
TRIE_BITMAP_SET(trie,*ch);
if ( folder )
STR_LEN(convert)++;
} else {
+#ifdef DEBUGGING
if (state>1)
DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
+#endif
break;
}
}
if (PL_regkind[OP(scan)] == EXACT) \
join_exact(pRExC_state,(scan),(min),(flags),NULL,depth+1)
-U32
+STATIC U32
S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags,regnode *val, U32 depth) {
/* Merge several consecutive EXACTish nodes into one. */
regnode *n = regnext(scan);
U32 stopnow = 0;
#ifdef DEBUGGING
regnode *stop = scan;
-#endif
GET_RE_DEBUG_FLAGS_DECL;
+#else
+ PERL_UNUSED_ARG(depth);
+#endif
+#ifndef EXPERIMENTAL_INPLACESCAN
+ PERL_UNUSED_ARG(flags);
+ PERL_UNUSED_ARG(val);
+#endif
DEBUG_PEEP("join",scan,depth);
/* Skip NOTHING, merge EXACT*. */
if (OP(n) == TAIL || n > next)
stringok = 0;
if (PL_regkind[OP(n)] == NOTHING) {
-
DEBUG_PEEP("skip:",n,depth);
NEXT_OFF(scan) += NEXT_OFF(n);
next = n + NODE_STEP_REGNODE;
if (stopnow) break;
}
-#ifdef EXPERIMENTAL_INPLACESCAN
- if (flags && !NEXT_OFF(n)) {
- DEBUG_PEEP("atch",val,depth);
- if (reg_off_by_arg[OP(n)]) {
- ARG_SET(n, val - n);
- }
- else {
- NEXT_OFF(n) = val - n;
- }
- stopnow=1;
- }
+#ifdef EXPERIMENTAL_INPLACESCAN
+ if (flags && !NEXT_OFF(n)) {
+ DEBUG_PEEP("atch", val, depth);
+ if (reg_off_by_arg[OP(n)]) {
+ ARG_SET(n, val - n);
+ }
+ else {
+ NEXT_OFF(n) = val - n;
+ }
+ stopnow = 1;
+ }
#endif
}
SV *re_trie_maxbuff = NULL;
GET_RE_DEBUG_FLAGS_DECL;
+#ifdef DEBUGGING
+ StructCopy(&zero_scan_data, &data_fake, scan_data_t);
+#endif
while (scan && OP(scan) != END && scan < last) {
/* Peephole optimizer: */
}
scan->flags = (U8)minnext;
}
- if (data && data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
- pars++;
- if (data && (data_fake.flags & SF_HAS_EVAL))
- data->flags |= SF_HAS_EVAL;
- if (data)
+ if (data) {
+ if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
+ pars++;
+ if (data_fake.flags & SF_HAS_EVAL)
+ data->flags |= SF_HAS_EVAL;
data->whilem_c = data_fake.whilem_c;
+ }
if (f & SCF_DO_STCLASS_AND) {
const int was = (data->start_class->flags & ANYOF_EOS);
I32 sawopen = 0;
scan_data_t data;
RExC_state_t RExC_state;
- RExC_state_t *pRExC_state = &RExC_state;
+ RExC_state_t * const pRExC_state = &RExC_state;
#ifdef TRIE_STUDY_OPT
int restudied= 0;
RExC_state_t copyRExC_state;
if (OP(first) == IFMATCH) {
first = NEXTOPER(first);
first += EXTRA_STEP_2ARGS;
- } else /*xxx possible optimisation for /(?=)/*/
+ } else /* XXX possible optimisation for /(?=)/ */
first = NEXTOPER(first);
}
r->reganch |= ROPT_SKIP;
/* Scan is after the zeroth branch, first is atomic matcher. */
- DEBUG_COMPILE_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
- (IV)(first - scan + 1)));
+#ifdef TRIE_STUDY_OPT
+ DEBUG_COMPILE_r(
+ if (!restudied)
+ PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
+ (IV)(first - scan + 1))
+ );
+#else
+ DEBUG_COMPILE_r(
+ PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n",
+ (IV)(first - scan + 1))
+ );
+#endif
+
+
/*
* If there's something expensive in the r.e., find the
* longest literal string that must appear and make it the
Newxz(r->startp, RExC_npar, I32);
Newxz(r->endp, RExC_npar, I32);
- DEBUG_COMPILE_r({
- if (SvIV(re_debug_flags)> (RE_DEBUG_COMPILE | RE_DEBUG_EXECUTE))
- PerlIO_printf(Perl_debug_log,"Final program:\n");
+ DEBUG_r( RX_DEBUG_on(r) );
+ DEBUG_DUMP_r({
+ PerlIO_printf(Perl_debug_log,"Final program:\n");
regdump(r);
});
+ DEBUG_OFFSETS_r(if (r->offsets) {
+ const U32 len = r->offsets[0];
+ U32 i;
+ GET_RE_DEBUG_FLAGS_DECL;
+ PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
+ for (i = 1; i <= len; i++) {
+ if (r->offsets[i*2-1] || r->offsets[i*2])
+ PerlIO_printf(Perl_debug_log, "%"UVuf":%"UVuf"[%"UVuf"] ",
+ i, (UV)r->offsets[i*2-1], (UV)r->offsets[i*2]);
+ }
+ PerlIO_printf(Perl_debug_log, "\n");
+ });
return(r);
}
else \
num=REG_NODE_NUM(RExC_emit); \
if (RExC_lastnum!=num) \
- PerlIO_printf(Perl_debug_log,"%4d",num); \
+ PerlIO_printf(Perl_debug_log,"|%4d",num); \
else \
- PerlIO_printf(Perl_debug_log,"%4s",""); \
- PerlIO_printf(Perl_debug_log,"%*s%-4s", \
- (int)(10+(depth*2)), "", \
+ PerlIO_printf(Perl_debug_log,"|%4s",""); \
+ PerlIO_printf(Perl_debug_log,"|%*s%-4s", \
+ (int)((depth*2)), "", \
(funcname) \
); \
RExC_lastnum=num; \
case we need to change the emitted regop to an EXACT. */
const char * orig_parse = RExC_parse;
GET_RE_DEBUG_FLAGS_DECL;
+#ifndef DEBUGGING
+ PERL_UNUSED_ARG(depth);
+#endif
+
DEBUG_PARSE("clas");
/* Assume we are going to generate an ANYOF node. */
dVAR;
register regnode *scan;
GET_RE_DEBUG_FLAGS_DECL;
+#ifndef DEBUGGING
+ PERL_UNUSED_ARG(depth);
+#endif
if (SIZE_ONLY)
return;
if (r->reganch & ROPT_EVAL_SEEN)
PerlIO_printf(Perl_debug_log, "with eval ");
PerlIO_printf(Perl_debug_log, "\n");
- if (r->offsets) {
- const U32 len = r->offsets[0];
- GET_RE_DEBUG_FLAGS_DECL;
- DEBUG_OFFSETS_r({
- U32 i;
- PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
- for (i = 1; i <= len; i++) {
- if (!(SvIV(re_debug_flags) & RE_DEBUG_OLD_OFFSETS)) {
- if (r->offsets[i*2-1] || r->offsets[i*2])
- PerlIO_printf(Perl_debug_log, "%"UVuf":",i);
- else
- continue;
- }
- PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ",
- (UV)r->offsets[i*2-1], (UV)r->offsets[i*2]);
- }
- PerlIO_printf(Perl_debug_log, "\n");
- });
- }
#else
PERL_UNUSED_CONTEXT;
PERL_UNUSED_ARG(r);
* be the best for now since we have no flag "this EXACTish
* node was UTF-8" --jhi */
const bool do_utf8 = is_utf8_string((U8*)STRING(o), STR_LEN(o));
- const char * const s = do_utf8 ?
- pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
- UNI_DISPLAY_REGEX) :
- STRING(o);
- const int len = do_utf8 ?
- strlen(s) :
- STR_LEN(o);
+ RE_PV_DISPLAY_DECL(s, len, do_utf8, dsv, STRING(o), STR_LEN(o), 60);
+
Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>",
PL_colors[0],
len, s,
PERL_UNUSED_CONTEXT;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_ARG(o);
+ PERL_UNUSED_ARG(prog);
#endif /* DEBUGGING */
}
Perl_pregfree(pTHX_ struct regexp *r)
{
dVAR;
-#ifdef DEBUGGING
- SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
-#endif
+
+
+
GET_RE_DEBUG_FLAGS_DECL;
if (!r || (--r->refcnt > 0))
return;
- DEBUG_r(if (re_debug_flags && (SvIV(re_debug_flags) & RE_DEBUG_COMPILE)) {
- const char * const s = (r->reganch & ROPT_UTF8)
- ? pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60, UNI_DISPLAY_REGEX)
- : pv_display(dsv, r->precomp, r->prelen, 0, 60);
- const int len = SvCUR(dsv);
- if (!PL_colorset)
- reginitcolors();
- PerlIO_printf(Perl_debug_log,
- "%sFreeing REx:%s %s%*.*s%s%s\n",
- PL_colors[4],PL_colors[5],PL_colors[0],
- len, len, s,
- PL_colors[1],
- len > 60 ? "..." : "");
+ DEBUG_COMPILE_r(if (RX_DEBUG(r)){
+ RE_PV_DISPLAY_DECL(s, len, (r->reganch & ROPT_UTF8),
+ PERL_DEBUG_PAD_ZERO(0), r->precomp, r->prelen, 60);
+
+ if (!PL_colorset)
+ reginitcolors();
+ PerlIO_printf(Perl_debug_log,
+ "%sFreeing REx:%s %s%*.*s%s%s\n",
+ PL_colors[4],PL_colors[5],PL_colors[0],
+ len, len, s,
+ PL_colors[1],
+ len > 60 ? "..." : "");
});
/* gcov results gave these as non-null 100% of the time, so there's no
case 'n':
break;
case 'T':
- {
+ { /* Aho Corasick add-on structure for a trie node.
+ Used in stclass optimization only */
U32 refcount;
reg_ac_data *aho=(reg_ac_data*)r->data->data[n];
OP_REFCNT_LOCK;
aho->trie=NULL; /* not necessary to free this as it is
handled by the 't' case */
Safefree(r->data->data[n]); /* do this last!!!! */
+ Safefree(r->regstclass);
}
}
break;
case 't':
{
+ /* trie structure. */
U32 refcount;
reg_trie_data *trie=(reg_trie_data*)r->data->data[n];
OP_REFCNT_LOCK;
if (trie->wordlen)
Safefree(trie->wordlen);
#ifdef DEBUGGING
- if (trie->words)
- SvREFCNT_dec((SV*)trie->words);
- if (trie->revcharmap)
- SvREFCNT_dec((SV*)trie->revcharmap);
+ if (RX_DEBUG(r)) {
+ if (trie->words)
+ SvREFCNT_dec((SV*)trie->words);
+ if (trie->revcharmap)
+ SvREFCNT_dec((SV*)trie->revcharmap);
+ }
#endif
Safefree(r->data->data[n]); /* do this last!!!! */
}
/* Where, what. */
if (OP(node) == OPTIMIZED) {
- if (!optstart && (SvIV(re_debug_flags) & RE_DEBUG_OPTIMISE))
+ if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE))
optstart = node;
else
goto after_print;
after_print:
if (PL_regkind[(U8)op] == BRANCHJ) {
- register const regnode *nnode = (OP(next) == LONGJMP
+ assert(next);
+ {
+ register const regnode *nnode = (OP(next) == LONGJMP
? regnext((regnode *)next)
: next);
- if (last && nnode > last)
- nnode = last;
- DUMPUNTIL(r, start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
+ if (last && nnode > last)
+ nnode = last;
+ DUMPUNTIL(r, start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1);
+ }
}
else if (PL_regkind[(U8)op] == BRANCH) {
+ assert(next);
DUMPUNTIL(r, start, NEXTOPER(node), next, sv, l + 1);
}
else if ( PL_regkind[(U8)op] == TRIE ) {
(int)TRIE_CHARCOUNT(trie),
trie->uniquecharcount,
(IV)TRIE_LASTSTATE(trie)-1,
- trie->minlen, trie->maxlen
+ (int)trie->minlen,
+ (int)trie->maxlen
);
if (trie->bitmap) {
int i;
NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1);
}
else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) {
+ assert(next);
DUMPUNTIL(r, start, NEXTOPER(node) + EXTRA_STEP_2ARGS,
next, sv, l + 1);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff