#ifdef DEBUGGING
int
-re_printf(pTHX_ const char *fmt, ...)
+Perl_re_printf(pTHX_ const char *fmt, ...)
{
va_list ap;
int result;
#define DEBUG_RExC_seen() \
DEBUG_OPTIMISE_MORE_r({ \
- re_printf("RExC_seen: "); \
+ Perl_re_printf( aTHX_ "RExC_seen: "); \
\
if (RExC_seen & REG_ZERO_LEN_SEEN) \
- re_printf("REG_ZERO_LEN_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_ZERO_LEN_SEEN "); \
\
if (RExC_seen & REG_LOOKBEHIND_SEEN) \
- re_printf("REG_LOOKBEHIND_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_LOOKBEHIND_SEEN "); \
\
if (RExC_seen & REG_GPOS_SEEN) \
- re_printf("REG_GPOS_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_GPOS_SEEN "); \
\
if (RExC_seen & REG_RECURSE_SEEN) \
- re_printf("REG_RECURSE_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_RECURSE_SEEN "); \
\
if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \
- re_printf("REG_TOP_LEVEL_BRANCHES_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_TOP_LEVEL_BRANCHES_SEEN "); \
\
if (RExC_seen & REG_VERBARG_SEEN) \
- re_printf("REG_VERBARG_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_VERBARG_SEEN "); \
\
if (RExC_seen & REG_CUTGROUP_SEEN) \
- re_printf("REG_CUTGROUP_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_CUTGROUP_SEEN "); \
\
if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \
- re_printf("REG_RUN_ON_COMMENT_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_RUN_ON_COMMENT_SEEN "); \
\
if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \
- re_printf("REG_UNFOLDED_MULTI_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_UNFOLDED_MULTI_SEEN "); \
\
if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \
- re_printf("REG_UNBOUNDED_QUANTIFIER_SEEN "); \
+ Perl_re_printf( aTHX_ "REG_UNBOUNDED_QUANTIFIER_SEEN "); \
\
- re_printf("\n"); \
+ Perl_re_printf( aTHX_ "\n"); \
});
#define DEBUG_SHOW_STUDY_FLAG(flags,flag) \
- if ((flags) & flag) re_printf( "%s ", #flag)
+ if ((flags) & flag) Perl_re_printf( aTHX_ "%s ", #flag)
#define DEBUG_SHOW_STUDY_FLAGS(flags,open_str,close_str) \
if ( ( flags ) ) { \
- re_printf( "%s", open_str); \
+ Perl_re_printf( aTHX_ "%s", open_str); \
DEBUG_SHOW_STUDY_FLAG(flags,SF_FL_BEFORE_SEOL); \
DEBUG_SHOW_STUDY_FLAG(flags,SF_FL_BEFORE_MEOL); \
DEBUG_SHOW_STUDY_FLAG(flags,SF_IS_INF); \
DEBUG_SHOW_STUDY_FLAG(flags,SCF_SEEN_ACCEPT); \
DEBUG_SHOW_STUDY_FLAG(flags,SCF_TRIE_DOING_RESTUDY); \
DEBUG_SHOW_STUDY_FLAG(flags,SCF_IN_DEFINE); \
- re_printf( "%s", close_str); \
+ Perl_re_printf( aTHX_ "%s", close_str); \
}
#define DEBUG_STUDYDATA(str,data,depth) \
DEBUG_OPTIMISE_MORE_r(if(data){ \
- re_indentf( "" str "Pos:%"IVdf"/%"IVdf \
+ Perl_re_indentf( aTHX_ "" str "Pos:%"IVdf"/%"IVdf \
" Flags: 0x%"UVXf, \
depth, \
(IV)((data)->pos_min), \
(UV)((data)->flags) \
); \
DEBUG_SHOW_STUDY_FLAGS((data)->flags," [ ","]"); \
- re_printf( \
+ Perl_re_printf( aTHX_ \
" Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \
(IV)((data)->whilem_c), \
(IV)((data)->last_closep ? *((data)->last_closep) : -1), \
is_inf ? "INF " : "" \
); \
if ((data)->last_found) \
- re_printf( \
+ Perl_re_printf( aTHX_ \
"Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \
" %sFloat: '%s' @ %"IVdf"/%"IVdf"", \
SvPVX_const((data)->last_found), \
(IV)((data)->offset_float_min), \
(IV)((data)->offset_float_max) \
); \
- re_printf("\n"); \
+ Perl_re_printf( aTHX_ "\n"); \
});
PERL_ARGS_ASSERT_DUMP_TRIE;
- re_indentf( "Char : %-6s%-6s%-4s ",
+ Perl_re_indentf( aTHX_ "Char : %-6s%-6s%-4s ",
depth+1,
"Match","Base","Ofs" );
for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
SV ** const tmp = av_fetch( revcharmap, state, 0);
if ( tmp ) {
- re_printf( "%*s",
+ Perl_re_printf( aTHX_ "%*s",
colwidth,
pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
PL_colors[0], PL_colors[1],
);
}
}
- re_printf( "\n%*sState|-----------------------",
+ Perl_re_printf( aTHX_ "\n%*sState|-----------------------",
depth+1);
for( state = 0 ; state < trie->uniquecharcount ; state++ )
- re_printf( "%.*s", colwidth, "--------");
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "%.*s", colwidth, "--------");
+ Perl_re_printf( aTHX_ "\n");
for( state = 1 ; state < trie->statecount ; state++ ) {
const U32 base = trie->states[ state ].trans.base;
- re_indentf( "#%4"UVXf"|",
+ Perl_re_indentf( aTHX_ "#%4"UVXf"|",
depth+1, (UV)state);
if ( trie->states[ state ].wordnum ) {
- re_printf( " W%4X",
+ Perl_re_printf( aTHX_ " W%4X",
trie->states[ state ].wordnum );
} else {
- re_printf( "%6s", "" );
+ Perl_re_printf( aTHX_ "%6s", "" );
}
- re_printf( " @%4"UVXf" ", (UV)base );
+ Perl_re_printf( aTHX_ " @%4"UVXf" ", (UV)base );
if ( base ) {
U32 ofs = 0;
!= state))
ofs++;
- re_printf( "+%2"UVXf"[ ", (UV)ofs);
+ Perl_re_printf( aTHX_ "+%2"UVXf"[ ", (UV)ofs);
for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
if ( ( base + ofs >= trie->uniquecharcount )
&& trie->trans[ base + ofs
- trie->uniquecharcount ].check == state )
{
- re_printf( "%*"UVXf,
+ Perl_re_printf( aTHX_ "%*"UVXf,
colwidth,
(UV)trie->trans[ base + ofs
- trie->uniquecharcount ].next );
} else {
- re_printf( "%*s",colwidth," ." );
+ Perl_re_printf( aTHX_ "%*s",colwidth," ." );
}
}
- re_printf( "]");
+ Perl_re_printf( aTHX_ "]");
}
- re_printf( "\n" );
+ Perl_re_printf( aTHX_ "\n" );
}
- re_indentf( "word_info N:(prev,len)=",
+ Perl_re_indentf( aTHX_ "word_info N:(prev,len)=",
depth);
for (word=1; word <= trie->wordcount; word++) {
- re_printf( " %d:(%d,%d)",
+ Perl_re_printf( aTHX_ " %d:(%d,%d)",
(int)word, (int)(trie->wordinfo[word].prev),
(int)(trie->wordinfo[word].len));
}
- re_printf( "\n" );
+ Perl_re_printf( aTHX_ "\n" );
}
/*
Dumps a fully constructed but uncompressed trie in list form.
PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
/* print out the table precompression. */
- re_indentf( "State :Word | Transition Data\n",
+ Perl_re_indentf( aTHX_ "State :Word | Transition Data\n",
depth+1 );
- re_indentf( "%s",
+ Perl_re_indentf( aTHX_ "%s",
depth+1, "------:-----+-----------------\n" );
for( state=1 ; state < next_alloc ; state ++ ) {
U16 charid;
- re_indentf( " %4"UVXf" :",
+ Perl_re_indentf( aTHX_ " %4"UVXf" :",
depth+1, (UV)state );
if ( ! trie->states[ state ].wordnum ) {
- re_printf( "%5s| ","");
+ Perl_re_printf( aTHX_ "%5s| ","");
} else {
- re_printf( "W%4x| ",
+ Perl_re_printf( aTHX_ "W%4x| ",
trie->states[ state ].wordnum
);
}
SV ** const tmp = av_fetch( revcharmap,
TRIE_LIST_ITEM(state,charid).forid, 0);
if ( tmp ) {
- re_printf( "%*s:%3X=%4"UVXf" | ",
+ Perl_re_printf( aTHX_ "%*s:%3X=%4"UVXf" | ",
colwidth,
pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
colwidth,
(UV)TRIE_LIST_ITEM(state,charid).newstate
);
if (!(charid % 10))
- re_printf( "\n%*s| ",
+ Perl_re_printf( aTHX_ "\n%*s| ",
(int)((depth * 2) + 14), "");
}
}
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "\n");
}
}
that they are identical.
*/
- re_indentf( "Char : ", depth+1 );
+ Perl_re_indentf( aTHX_ "Char : ", depth+1 );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
SV ** const tmp = av_fetch( revcharmap, charid, 0);
if ( tmp ) {
- re_printf( "%*s",
+ Perl_re_printf( aTHX_ "%*s",
colwidth,
pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
PL_colors[0], PL_colors[1],
}
}
- re_printf( "\n%*sState+-",depth+1 );
+ Perl_re_printf( aTHX_ "\n%*sState+-",depth+1 );
for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
- re_printf( "%.*s", colwidth,"--------");
+ Perl_re_printf( aTHX_ "%.*s", colwidth,"--------");
}
- re_printf( "\n" );
+ Perl_re_printf( aTHX_ "\n" );
for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
- re_indentf( "%4"UVXf" : ",
+ Perl_re_indentf( aTHX_ "%4"UVXf" : ",
depth+1,
(UV)TRIE_NODENUM( state ) );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
if (v)
- re_printf( "%*"UVXf, colwidth, v );
+ Perl_re_printf( aTHX_ "%*"UVXf, colwidth, v );
else
- re_printf( "%*s", colwidth, "." );
+ Perl_re_printf( aTHX_ "%*s", colwidth, "." );
}
if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
- re_printf( " (%4"UVXf")\n",
+ Perl_re_printf( aTHX_ " (%4"UVXf")\n",
(UV)trie->trans[ state ].check );
} else {
- re_printf( " (%4"UVXf") W%4X\n",
+ Perl_re_printf( aTHX_ " (%4"UVXf") W%4X\n",
(UV)trie->trans[ state ].check,
trie->states[ TRIE_NODENUM( state ) ].wordnum );
}
sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
}
DEBUG_TRIE_COMPILE_r({
- re_indentf(
+ Perl_re_indentf( aTHX_
"make_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
depth+1,
REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
}
} /* end first pass */
DEBUG_TRIE_COMPILE_r(
- re_indentf(
+ Perl_re_indentf( aTHX_
"TRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
depth+1,
( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
STRLEN transcount = 1;
- DEBUG_TRIE_COMPILE_MORE_r( re_indentf( "Compiling trie using list compiler\n",
+ DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using list compiler\n",
depth+1));
trie->states = (reg_trie_state *)
/*
DEBUG_TRIE_COMPILE_MORE_r(
- re_printf( "tp: %d zp: %d ",tp,zp)
+ Perl_re_printf( aTHX_ "tp: %d zp: %d ",tp,zp)
);
*/
}
/*
DEBUG_TRIE_COMPILE_MORE_r(
- re_printf( " base: %d\n",base);
+ Perl_re_printf( aTHX_ " base: %d\n",base);
);
*/
trie->states[ state ].trans.base=base;
we have to use TRIE_NODENUM() to convert.
*/
- DEBUG_TRIE_COMPILE_MORE_r( re_indentf( "Compiling trie using table compiler\n",
+ DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using table compiler\n",
depth+1));
trie->trans = (reg_trie_trans *)
PerlMemShared_realloc( trie->states, laststate
* sizeof(reg_trie_state) );
DEBUG_TRIE_COMPILE_MORE_r(
- re_indentf( "Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+ Perl_re_indentf( aTHX_ "Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
depth+1,
(int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount
+ 1 ),
} /* end table compress */
}
DEBUG_TRIE_COMPILE_MORE_r(
- re_indentf( "Statecount:%"UVxf" Lasttrans:%"UVxf"\n",
+ Perl_re_indentf( aTHX_ "Statecount:%"UVxf" Lasttrans:%"UVxf"\n",
depth+1,
(UV)trie->statecount,
(UV)trie->lasttrans)
});
}
DEBUG_OPTIMISE_r(
- re_indentf( "MJD offset:%"UVuf" MJD length:%"UVuf"\n",
+ Perl_re_indentf( aTHX_ "MJD offset:%"UVuf" MJD length:%"UVuf"\n",
depth+1,
(UV)mjd_offset, (UV)mjd_nodelen)
);
if ( count == 2 ) {
Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char);
DEBUG_OPTIMISE_r(
- re_indentf( "New Start State=%"UVuf" Class: [",
+ Perl_re_indentf( aTHX_ "New Start State=%"UVuf" Class: [",
depth+1,
(UV)state));
if (idx >= 0) {
if ( folder )
TRIE_BITMAP_SET(trie, folder[ *ch ]);
DEBUG_OPTIMISE_r(
- re_printf( "%s", (char*)ch)
+ Perl_re_printf( aTHX_ "%s", (char*)ch)
);
}
}
TRIE_BITMAP_SET(trie,*ch);
if ( folder )
TRIE_BITMAP_SET(trie,folder[ *ch ]);
- DEBUG_OPTIMISE_r(re_printf("%s", ch));
+ DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "%s", ch));
}
idx = ofs;
}
char *ch = SvPV( *tmp, len );
DEBUG_OPTIMISE_r({
SV *sv=sv_newmortal();
- re_indentf( "Prefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
+ Perl_re_indentf( aTHX_ "Prefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
depth+1,
(UV)state, (UV)idx,
pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
} else {
#ifdef DEBUGGING
if (state>1)
- DEBUG_OPTIMISE_r(re_printf("]\n"));
+ DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "]\n"));
#endif
break;
}
*/
fail[ 0 ] = fail[ 1 ] = 0;
DEBUG_TRIE_COMPILE_r({
- re_indentf( "Stclass Failtable (%"UVuf" states): 0",
+ Perl_re_indentf( aTHX_ "Stclass Failtable (%"UVuf" states): 0",
depth, (UV)numstates
);
for( q_read=1; q_read<numstates; q_read++ ) {
- re_printf( ", %"UVuf, (UV)fail[q_read]);
+ Perl_re_printf( aTHX_ ", %"UVuf, (UV)fail[q_read]);
}
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "\n");
});
Safefree(q);
/*RExC_seen |= REG_TRIEDFA_SEEN;*/
DEBUG_OPTIMISE_r({if (scan){ \
regnode *Next = regnext(scan); \
regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state);\
- re_indentf( "" str ">%3d: %s (%d)", \
+ Perl_re_indentf( aTHX_ "" str ">%3d: %s (%d)", \
depth, REG_NODE_NUM(scan), SvPV_nolen_const(RExC_mysv),\
Next ? (REG_NODE_NUM(Next)) : 0 );\
DEBUG_SHOW_STUDY_FLAGS(flags," [ ","]");\
- re_printf( "\n"); \
+ Perl_re_printf( aTHX_ "\n"); \
}});
/* The below joins as many adjacent EXACTish nodes as possible into a single
);
DEBUG_OPTIMISE_MORE_r(
{
- re_indentf( "study_chunk stopparen=%ld recursed_count=%lu depth=%lu recursed_depth=%lu scan=%p last=%p",
+ Perl_re_indentf( aTHX_ "study_chunk stopparen=%ld recursed_count=%lu depth=%lu recursed_depth=%lu scan=%p last=%p",
depth, (long)stopparen,
(unsigned long)RExC_study_chunk_recursed_count,
(unsigned long)depth, (unsigned long)recursed_depth,
(( j - 1 ) * RExC_study_chunk_recursed_bytes), i)
)
) {
- re_printf(" %d",(int)i);
+ Perl_re_printf( aTHX_ " %d",(int)i);
break;
}
}
if ( j + 1 < recursed_depth ) {
- re_printf( ",");
+ Perl_re_printf( aTHX_ ",");
}
}
}
- re_printf("\n");
+ Perl_re_printf( aTHX_ "\n");
}
);
while ( scan && OP(scan) != END && scan < last ){
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, RExC_mysv, tail, NULL, pRExC_state);
- re_indentf( "%s %"UVuf":%s\n",
+ Perl_re_indentf( aTHX_ "%s %"UVuf":%s\n",
depth+1,
"Looking for TRIE'able sequences. Tail node is ",
(UV)(tail - RExC_emit_start),
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, RExC_mysv, cur, NULL, pRExC_state);
- re_indentf( "- %d:%s (%d)",
+ Perl_re_indentf( aTHX_ "- %d:%s (%d)",
depth+1,
REG_NODE_NUM(cur), SvPV_nolen_const( RExC_mysv ), REG_NODE_NUM(cur) );
regprop(RExC_rx, RExC_mysv, noper, NULL, pRExC_state);
- re_printf( " -> %d:%s",
+ Perl_re_printf( aTHX_ " -> %d:%s",
REG_NODE_NUM(noper), SvPV_nolen_const(RExC_mysv));
if ( noper_next ) {
regprop(RExC_rx, RExC_mysv, noper_next, NULL, pRExC_state);
- re_printf("\t=> %d:%s\t",
+ Perl_re_printf( aTHX_ "\t=> %d:%s\t",
REG_NODE_NUM(noper_next), SvPV_nolen_const(RExC_mysv));
}
- re_printf( "(First==%d,Last==%d,Cur==%d,tt==%s,ntt==%s,nntt==%s)\n",
+ Perl_re_printf( aTHX_ "(First==%d,Last==%d,Cur==%d,tt==%s,ntt==%s,nntt==%s)\n",
REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur),
PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype]
);
} /* loop over branches */
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, RExC_mysv, cur, NULL, pRExC_state);
- re_indentf( "- %s (%d) <SCAN FINISHED> ",
+ Perl_re_indentf( aTHX_ "- %s (%d) <SCAN FINISHED> ",
depth+1, SvPV_nolen_const( RExC_mysv ),REG_NODE_NUM(cur));
- re_printf( "(First==%d, Last==%d, Cur==%d, tt==%s)\n",
+ Perl_re_printf( aTHX_ "(First==%d, Last==%d, Cur==%d, tt==%s)\n",
REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur),
PL_reg_name[trietype]
);
* turn it into a plain NOTHING op. */
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, RExC_mysv, cur, NULL, pRExC_state);
- re_indentf( "- %s (%d) <NOTHING BRANCH SEQUENCE>\n",
+ Perl_re_indentf( aTHX_ "- %s (%d) <NOTHING BRANCH SEQUENCE>\n",
depth+1,
SvPV_nolen_const( RExC_mysv ),REG_NODE_NUM(cur));
/* It is counted once already... */
data->pos_min += minnext * (mincount - counted);
#if 0
-re_printf( "counted=%"UVuf" deltanext=%"UVuf
+Perl_re_printf( aTHX_ "counted=%"UVuf" deltanext=%"UVuf
" SSize_t_MAX=%"UVuf" minnext=%"UVuf
" maxcount=%"UVuf" mincount=%"UVuf"\n",
(UV)counted, (UV)deltanext, (UV)SSize_t_MAX, (UV)minnext, (UV)maxcount,
(UV)mincount);
if (deltanext != SSize_t_MAX)
-re_printf( "LHS=%"UVuf" RHS=%"UVuf"\n",
+Perl_re_printf( aTHX_ "LHS=%"UVuf" RHS=%"UVuf"\n",
(UV)(-counted * deltanext + (minnext + deltanext) * maxcount
- minnext * mincount), (UV)(SSize_t_MAX - data->pos_delta));
#endif
/* Dispatch a request to compile a regexp to correct regexp engine. */
DEBUG_COMPILE_r({
- re_printf( "Using engine %"UVxf"\n",
+ Perl_re_printf( aTHX_ "Using engine %"UVxf"\n",
PTR2UV(eng));
});
return CALLREGCOMP_ENG(eng, pattern, flags);
bool do_end = 0;
GET_RE_DEBUG_FLAGS_DECL;
- DEBUG_PARSE_r(re_printf(
+ DEBUG_PARSE_r(Perl_re_printf( aTHX_
"UTF8 mismatch! Converting to utf8 for resizing and compile\n"));
Newx(dst, *plen_p * 2 + 1, U8);
*p++ = 'x';
*p++ = '\0';
DEBUG_COMPILE_r({
- re_printf(
+ Perl_re_printf( aTHX_
"%sre-parsing pattern for runtime code:%s %s\n",
PL_colors[4],PL_colors[5],newpat);
});
}
- DEBUG_PARSE_r(re_printf(
+ DEBUG_PARSE_r(Perl_re_printf( aTHX_
"Assembling pattern from %d elements%s\n", pat_count,
orig_rx_flags & RXf_SPLIT ? " for split" : ""));
*is_bare_re = TRUE;
SvREFCNT_inc(re);
Safefree(pRExC_state->code_blocks);
- DEBUG_PARSE_r(re_printf(
+ DEBUG_PARSE_r(Perl_re_printf( aTHX_
"Precompiled pattern%s\n",
orig_rx_flags & RXf_SPLIT ? " for split" : ""));
DEBUG_COMPILE_r({
SV *dsv= sv_newmortal();
RE_PV_QUOTED_DECL(s, RExC_utf8, dsv, exp, plen, 60);
- re_printf( "%sCompiling REx%s %s\n",
+ Perl_re_printf( aTHX_ "%sCompiling REx%s %s\n",
PL_colors[4],PL_colors[5],s);
});
assert(*RExC_end == '\0');
DEBUG_PARSE_r(
- re_printf( "Starting first pass (sizing)\n");
+ Perl_re_printf( aTHX_ "Starting first pass (sizing)\n");
RExC_lastnum=0;
RExC_lastparse=NULL;
);
pRExC_state->num_code_blocks);
}
else {
- DEBUG_PARSE_r(re_printf(
+ DEBUG_PARSE_r(Perl_re_printf( aTHX_
"Need to redo pass 1\n"));
}
SvLEN_set(code_blocksv,0); /* no you can't have it, sv_clear */
DEBUG_PARSE_r({
- re_printf(
+ Perl_re_printf( aTHX_
"Required size %"IVdf" nodes\n"
"Starting second pass (creation)\n",
(IV)RExC_size);
/* Useful during FAIL. */
#ifdef RE_TRACK_PATTERN_OFFSETS
Newxz(ri->u.offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
- DEBUG_OFFSETS_r(re_printf(
+ DEBUG_OFFSETS_r(Perl_re_printf( aTHX_
"%s %"UVuf" bytes for offset annotations.\n",
ri->u.offsets ? "Got" : "Couldn't get",
(UV)((2*RExC_size+1) * sizeof(U32))));
/* setup various meta data about recursion, this all requires
* RExC_npar to be correctly set, and a bit later on we clear it */
if (RExC_seen & REG_RECURSE_SEEN) {
- DEBUG_OPTIMISE_MORE_r(re_printf(
+ DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
"%*s%*s Setting up open/close parens\n",
22, "| |", (int)(0 * 2 + 1), ""));
Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for generation pass, flags=%#"UVxf"", (UV) flags);
}
DEBUG_OPTIMISE_r(
- re_printf( "Starting post parse optimization\n");
+ Perl_re_printf( aTHX_ "Starting post parse optimization\n");
);
/* XXXX To minimize changes to RE engine we always allocate
copyRExC_state = RExC_state;
} else {
U32 seen=RExC_seen;
- DEBUG_OPTIMISE_r(re_printf("Restudying\n"));
+ DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "Restudying\n"));
RExC_state = copyRExC_state;
if (seen & REG_TOP_LEVEL_BRANCHES_SEEN)
#ifdef TRIE_STUDY_OPT
DEBUG_PARSE_r(
if (!restudied)
- re_printf( "first at %"IVdf"\n",
+ Perl_re_printf( aTHX_ "first at %"IVdf"\n",
(IV)(first - scan + 1))
);
#else
DEBUG_PARSE_r(
- re_printf( "first at %"IVdf"\n",
+ Perl_re_printf( aTHX_ "first at %"IVdf"\n",
(IV)(first - scan + 1))
);
#endif
r->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */
DEBUG_COMPILE_r({ SV *sv = sv_newmortal();
regprop(r, sv, (regnode*)data.start_class, NULL, pRExC_state);
- re_printf(
+ Perl_re_printf( aTHX_
"synthetic stclass \"%s\".\n",
SvPVX_const(sv));});
data.start_class = NULL;
regnode_ssc ch_class;
SSize_t last_close = 0;
- DEBUG_PARSE_r(re_printf( "\nMulti Top Level\n"));
+ DEBUG_PARSE_r(Perl_re_printf( aTHX_ "\nMulti Top Level\n"));
scan = ri->program + 1;
ssc_init(pRExC_state, &ch_class);
r->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */
DEBUG_COMPILE_r({ SV* sv = sv_newmortal();
regprop(r, sv, (regnode*)data.start_class, NULL, pRExC_state);
- re_printf(
+ Perl_re_printf( aTHX_
"synthetic stclass \"%s\".\n",
SvPVX_const(sv));});
data.start_class = NULL;
/* Guard against an embedded (?=) or (?<=) with a longer minlen than
the "real" pattern. */
DEBUG_OPTIMISE_r({
- re_printf("minlen: %"IVdf" r->minlen:%"IVdf" maxlen:%"IVdf"\n",
+ Perl_re_printf( aTHX_ "minlen: %"IVdf" r->minlen:%"IVdf" maxlen:%"IVdf"\n",
(IV)minlen, (IV)r->minlen, (IV)RExC_maxlen);
});
r->minlenret = minlen;
Newxz(r->offs, RExC_npar, regexp_paren_pair);
/* assume we don't need to swap parens around before we match */
DEBUG_TEST_r({
- re_printf("study_chunk_recursed_count: %lu\n",
+ Perl_re_printf( aTHX_ "study_chunk_recursed_count: %lu\n",
(unsigned long)RExC_study_chunk_recursed_count);
});
DEBUG_DUMP_r({
DEBUG_RExC_seen();
- re_printf("Final program:\n");
+ Perl_re_printf( aTHX_ "Final program:\n");
regdump(r);
});
#ifdef RE_TRACK_PATTERN_OFFSETS
const STRLEN len = ri->u.offsets[0];
STRLEN i;
GET_RE_DEBUG_FLAGS_DECL;
- re_printf(
+ Perl_re_printf( aTHX_
"Offsets: [%"UVuf"]\n\t", (UV)ri->u.offsets[0]);
for (i = 1; i <= len; i++) {
if (ri->u.offsets[i*2-1] || ri->u.offsets[i*2])
- re_printf( "%"UVuf":%"UVuf"[%"UVuf"] ",
+ Perl_re_printf( aTHX_ "%"UVuf":%"UVuf"[%"UVuf"] ",
(UV)i, (UV)ri->u.offsets[i*2-1], (UV)ri->u.offsets[i*2]);
}
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "\n");
});
#endif
#define DEBUG_PARSE_MSG(funcname) DEBUG_PARSE_r({ \
int num; \
if (RExC_lastparse!=RExC_parse) { \
- re_printf( "%s", \
+ Perl_re_printf( aTHX_ "%s", \
Perl_pv_pretty(aTHX_ RExC_mysv1, RExC_parse, \
RExC_end - RExC_parse, 16, \
"", "", \
) \
); \
} else \
- re_printf("%16s",""); \
+ Perl_re_printf( aTHX_ "%16s",""); \
\
if (SIZE_ONLY) \
num = RExC_size + 1; \
else \
num=REG_NODE_NUM(RExC_emit); \
if (RExC_lastnum!=num) \
- re_printf("|%4d",num); \
+ Perl_re_printf( aTHX_ "|%4d",num); \
else \
- re_printf("|%4s",""); \
- re_printf("|%*s%-4s", \
+ Perl_re_printf( aTHX_ "|%4s",""); \
+ Perl_re_printf( aTHX_ "|%*s%-4s", \
(int)((depth*2)), "", \
(funcname) \
); \
#define DEBUG_PARSE(funcname) DEBUG_PARSE_r({ \
DEBUG_PARSE_MSG((funcname)); \
- re_printf("%4s","\n"); \
+ Perl_re_printf( aTHX_ "%4s","\n"); \
})
#define DEBUG_PARSE_FMT(funcname,fmt,args) DEBUG_PARSE_r({\
DEBUG_PARSE_MSG((funcname)); \
- re_printf(fmt "\n",args); \
+ Perl_re_printf( aTHX_ fmt "\n",args); \
})
/* This section of code defines the inversion list object and its methods. The
vFAIL("Reference to nonexistent group");
}
RExC_recurse_count++;
- DEBUG_OPTIMISE_MORE_r(re_printf(
+ DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
"%*s%*s Recurse #%"UVuf" to %"IVdf"\n",
22, "| |", (int)(depth * 2 + 1), "",
(UV)ARG(ret), (IV)ARG2L(ret)));
RExC_nestroot = parno;
if (RExC_open_parens && !RExC_open_parens[parno])
{
- DEBUG_OPTIMISE_MORE_r(re_printf(
+ DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
"%*s%*s Setting open paren #%"IVdf" to %d\n",
22, "| |", (int)(depth * 2 + 1), "",
(IV)parno, REG_NODE_NUM(ret)));
case 1: case 2:
ender = reganode(pRExC_state, CLOSE, parno);
if ( RExC_close_parens ) {
- DEBUG_OPTIMISE_MORE_r(re_printf(
+ DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
"%*s%*s Setting close paren #%"IVdf" to %d\n",
22, "| |", (int)(depth * 2 + 1), "", (IV)parno, REG_NODE_NUM(ender)));
RExC_close_parens[parno]= ender;
assert(!RExC_end_op); /* there can only be one! */
RExC_end_op = ender;
if (RExC_close_parens) {
- DEBUG_OPTIMISE_MORE_r(re_printf(
+ DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_
"%*s%*s Setting close paren #0 (END) to %d\n",
22, "| |", (int)(depth * 2 + 1), "", REG_NODE_NUM(ender)));
DEBUG_PARSE_MSG("lsbr");
regprop(RExC_rx, RExC_mysv1, lastbr, NULL, pRExC_state);
regprop(RExC_rx, RExC_mysv2, ender, NULL, pRExC_state);
- re_printf( "~ tying lastbr %s (%"IVdf") to ender %s (%"IVdf") offset %"IVdf"\n",
+ Perl_re_printf( aTHX_ "~ tying lastbr %s (%"IVdf") to ender %s (%"IVdf") offset %"IVdf"\n",
SvPV_nolen_const(RExC_mysv1),
(IV)REG_NODE_NUM(lastbr),
SvPV_nolen_const(RExC_mysv2),
DEBUG_PARSE_MSG("NADA");
regprop(RExC_rx, RExC_mysv1, ret, NULL, pRExC_state);
regprop(RExC_rx, RExC_mysv2, ender, NULL, pRExC_state);
- re_printf( "~ converting ret %s (%"IVdf") to ender %s (%"IVdf") offset %"IVdf"\n",
+ Perl_re_printf( aTHX_ "~ converting ret %s (%"IVdf") to ender %s (%"IVdf") offset %"IVdf"\n",
SvPV_nolen_const(RExC_mysv1),
(IV)REG_NODE_NUM(ret),
SvPV_nolen_const(RExC_mysv2),
DEBUG_PARSE_r({
DEBUG_PARSE_MSG((scan==p ? "tail" : ""));
regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state);
- re_printf( "~ %s (%d) %s %s\n",
+ Perl_re_printf( aTHX_ "~ %s (%d) %s %s\n",
SvPV_nolen_const(RExC_mysv), REG_NODE_NUM(scan),
(temp == NULL ? "->" : ""),
(temp == NULL ? PL_reg_name[OP(val)] : "")
DEBUG_PARSE_r({
DEBUG_PARSE_MSG((scan==p ? "tsdy" : ""));
regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state);
- re_printf( "~ %s (%d) -> %s\n",
+ Perl_re_printf( aTHX_ "~ %s (%d) -> %s\n",
SvPV_nolen_const(RExC_mysv),
REG_NODE_NUM(scan),
PL_reg_name[exact]);
DEBUG_PARSE_r({
DEBUG_PARSE_MSG("");
regprop(RExC_rx, RExC_mysv, val, NULL, pRExC_state);
- re_printf(
+ Perl_re_printf( aTHX_
"~ attach to %s (%"IVdf") offset to %"IVdf"\n",
SvPV_nolen_const(RExC_mysv),
(IV)REG_NODE_NUM(val),
for (bit=0; bit<REG_INTFLAGS_NAME_SIZE; bit++) {
if (flags & (1<<bit)) {
if (!set++ && lead)
- re_printf( "%s",lead);
- re_printf( "%s ",PL_reg_intflags_name[bit]);
+ Perl_re_printf( aTHX_ "%s",lead);
+ Perl_re_printf( aTHX_ "%s ",PL_reg_intflags_name[bit]);
}
}
if (lead) {
if (set)
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "\n");
else
- re_printf( "%s[none-set]\n",lead);
+ Perl_re_printf( aTHX_ "%s[none-set]\n",lead);
}
}
continue;
}
if (!set++ && lead)
- re_printf( "%s",lead);
- re_printf( "%s ",PL_reg_extflags_name[bit]);
+ Perl_re_printf( aTHX_ "%s",lead);
+ Perl_re_printf( aTHX_ "%s ",PL_reg_extflags_name[bit]);
}
}
if ((cs = get_regex_charset(flags)) != REGEX_DEPENDS_CHARSET) {
if (!set++ && lead) {
- re_printf( "%s",lead);
+ Perl_re_printf( aTHX_ "%s",lead);
}
switch (cs) {
case REGEX_UNICODE_CHARSET:
- re_printf( "UNICODE");
+ Perl_re_printf( aTHX_ "UNICODE");
break;
case REGEX_LOCALE_CHARSET:
- re_printf( "LOCALE");
+ Perl_re_printf( aTHX_ "LOCALE");
break;
case REGEX_ASCII_RESTRICTED_CHARSET:
- re_printf( "ASCII-RESTRICTED");
+ Perl_re_printf( aTHX_ "ASCII-RESTRICTED");
break;
case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
- re_printf( "ASCII-MORE_RESTRICTED");
+ Perl_re_printf( aTHX_ "ASCII-MORE_RESTRICTED");
break;
default:
- re_printf( "UNKNOWN CHARACTER SET");
+ Perl_re_printf( aTHX_ "UNKNOWN CHARACTER SET");
break;
}
}
if (lead) {
if (set)
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "\n");
else
- re_printf( "%s[none-set]\n",lead);
+ Perl_re_printf( aTHX_ "%s[none-set]\n",lead);
}
}
#endif
if (r->anchored_substr) {
RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr),
RE_SV_DUMPLEN(r->anchored_substr), 30);
- re_printf(
+ Perl_re_printf( aTHX_
"anchored %s%s at %"IVdf" ",
s, RE_SV_TAIL(r->anchored_substr),
(IV)r->anchored_offset);
} else if (r->anchored_utf8) {
RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->anchored_utf8),
RE_SV_DUMPLEN(r->anchored_utf8), 30);
- re_printf(
+ Perl_re_printf( aTHX_
"anchored utf8 %s%s at %"IVdf" ",
s, RE_SV_TAIL(r->anchored_utf8),
(IV)r->anchored_offset);
if (r->float_substr) {
RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr),
RE_SV_DUMPLEN(r->float_substr), 30);
- re_printf(
+ Perl_re_printf( aTHX_
"floating %s%s at %"IVdf"..%"UVuf" ",
s, RE_SV_TAIL(r->float_substr),
(IV)r->float_min_offset, (UV)r->float_max_offset);
} else if (r->float_utf8) {
RE_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->float_utf8),
RE_SV_DUMPLEN(r->float_utf8), 30);
- re_printf(
+ Perl_re_printf( aTHX_
"floating utf8 %s%s at %"IVdf"..%"UVuf" ",
s, RE_SV_TAIL(r->float_utf8),
(IV)r->float_min_offset, (UV)r->float_max_offset);
}
if (r->check_substr || r->check_utf8)
- re_printf(
+ Perl_re_printf( aTHX_
(const char *)
(r->check_substr == r->float_substr
&& r->check_utf8 == r->float_utf8
? "(checking floating" : "(checking anchored"));
if (r->intflags & PREGf_NOSCAN)
- re_printf( " noscan");
+ Perl_re_printf( aTHX_ " noscan");
if (r->extflags & RXf_CHECK_ALL)
- re_printf( " isall");
+ Perl_re_printf( aTHX_ " isall");
if (r->check_substr || r->check_utf8)
- re_printf( ") ");
+ Perl_re_printf( aTHX_ ") ");
if (ri->regstclass) {
regprop(r, sv, ri->regstclass, NULL, NULL);
- re_printf( "stclass %s ", SvPVX_const(sv));
+ Perl_re_printf( aTHX_ "stclass %s ", SvPVX_const(sv));
}
if (r->intflags & PREGf_ANCH) {
- re_printf( "anchored");
+ Perl_re_printf( aTHX_ "anchored");
if (r->intflags & PREGf_ANCH_MBOL)
- re_printf( "(MBOL)");
+ Perl_re_printf( aTHX_ "(MBOL)");
if (r->intflags & PREGf_ANCH_SBOL)
- re_printf( "(SBOL)");
+ Perl_re_printf( aTHX_ "(SBOL)");
if (r->intflags & PREGf_ANCH_GPOS)
- re_printf( "(GPOS)");
- re_printf(" ");
+ Perl_re_printf( aTHX_ "(GPOS)");
+ Perl_re_printf( aTHX_ " ");
}
if (r->intflags & PREGf_GPOS_SEEN)
- re_printf( "GPOS:%"UVuf" ", (UV)r->gofs);
+ Perl_re_printf( aTHX_ "GPOS:%"UVuf" ", (UV)r->gofs);
if (r->intflags & PREGf_SKIP)
- re_printf( "plus ");
+ Perl_re_printf( aTHX_ "plus ");
if (r->intflags & PREGf_IMPLICIT)
- re_printf( "implicit ");
- re_printf( "minlen %"IVdf" ", (IV)r->minlen);
+ Perl_re_printf( aTHX_ "implicit ");
+ Perl_re_printf( aTHX_ "minlen %"IVdf" ", (IV)r->minlen);
if (r->extflags & RXf_EVAL_SEEN)
- re_printf( "with eval ");
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "with eval ");
+ Perl_re_printf( aTHX_ "\n");
DEBUG_FLAGS_r({
regdump_extflags("r->extflags: ",r->extflags);
regdump_intflags("r->intflags: ",r->intflags);
? prog->check_utf8 : prog->check_substr);
if (!PL_colorset) reginitcolors();
- re_printf(
+ Perl_re_printf( aTHX_
"%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n",
PL_colors[4],
RX_UTF8(r) ? "utf8 " : "",
SV *dsv= sv_newmortal();
RE_PV_QUOTED_DECL(s, RX_UTF8(rx),
dsv, RX_PRECOMP(rx), RX_PRELEN(rx), 60);
- re_printf("%sFreeing REx:%s %s\n",
+ Perl_re_printf( aTHX_ "%sFreeing REx:%s %s\n",
PL_colors[4],PL_colors[5],s);
}
});
#define CLEAR_OPTSTART \
if (optstart) STMT_START { \
- DEBUG_OPTIMISE_r(re_printf( \
+ DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ \
" (%"IVdf" nodes)\n", (IV)(node - optstart))); \
optstart=NULL; \
} STMT_END
PERL_ARGS_ASSERT_DUMPUNTIL;
#ifdef DEBUG_DUMPUNTIL
- re_printf( "--- %d : %d - %d - %d\n",indent,node-start,
+ Perl_re_printf( aTHX_ "--- %d : %d - %d - %d\n",indent,node-start,
last ? last-start : 0,plast ? plast-start : 0);
#endif
CLEAR_OPTSTART;
regprop(r, sv, node, NULL, NULL);
- re_printf( "%4"IVdf":%*s%s", (IV)(node - start),
+ Perl_re_printf( aTHX_ "%4"IVdf":%*s%s", (IV)(node - start),
(int)(2*indent + 1), "", SvPVX_const(sv));
if (OP(node) != OPTIMIZED) {
if (next == NULL) /* Next ptr. */
- re_printf( " (0)");
+ Perl_re_printf( aTHX_ " (0)");
else if (PL_regkind[(U8)op] == BRANCH
&& PL_regkind[OP(next)] != BRANCH )
- re_printf( " (FAIL)");
+ Perl_re_printf( aTHX_ " (FAIL)");
else
- re_printf( " (%"IVdf")", (IV)(next - start));
- re_printf("\n");
+ Perl_re_printf( aTHX_ " (%"IVdf")", (IV)(next - start));
+ Perl_re_printf( aTHX_ "\n");
}
after_print:
for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) {
SV ** const elem_ptr = av_fetch(trie_words,word_idx,0);
- re_indentf( "%s ",
+ Perl_re_indentf( aTHX_ "%s ",
indent+3,
elem_ptr
? pv_pretty(sv, SvPV_nolen_const(*elem_ptr),
);
if (trie->jump) {
U16 dist= trie->jump[word_idx+1];
- re_printf( "(%"UVuf")\n",
+ Perl_re_printf( aTHX_ "(%"UVuf")\n",
(UV)((dist ? this_trie + dist : next) - start));
if (dist) {
if (!nextbranch)
if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
nextbranch= regnext((regnode *)nextbranch);
} else {
- re_printf( "\n");
+ Perl_re_printf( aTHX_ "\n");
}
}
if (last && next > last)
}
CLEAR_OPTSTART;
#ifdef DEBUG_DUMPUNTIL
- re_printf( "--- %d\n", (int)indent);
+ Perl_re_printf( aTHX_ "--- %d\n", (int)indent);
#endif
return node;
}
#endif
#define NON_UTF8_TARGET_BUT_UTF8_REQUIRED(target) STMT_START { \
- DEBUG_EXECUTE_r(re_printf( "%s", non_utf8_target_but_utf8_required));\
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ "%s", non_utf8_target_but_utf8_required));\
goto target; \
} STMT_END
DEBUG_BUFFERS_r(
if ((int)maxopenparen > (int)parenfloor)
- re_printf(
+ Perl_re_printf( aTHX_
"rex=0x%"UVxf" offs=0x%"UVxf": saving capture indices:\n",
PTR2UV(rex),
PTR2UV(rex->offs)
SSPUSHIV(rex->offs[p].end);
SSPUSHIV(rex->offs[p].start);
SSPUSHINT(rex->offs[p].start_tmp);
- DEBUG_BUFFERS_r(re_printf(
+ DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
" \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"\n",
(UV)p,
(IV)rex->offs[p].start,
/* These are needed since we do not localize EVAL nodes: */
#define REGCP_SET(cp) \
DEBUG_STATE_r( \
- re_exec_indentf( \
+ Perl_re_exec_indentf( aTHX_ \
"Setting an EVAL scope, savestack=%"IVdf",\n", \
depth, (IV)PL_savestack_ix \
) \
#define REGCP_UNWIND(cp) \
DEBUG_STATE_r( \
if (cp != PL_savestack_ix) \
- re_exec_indentf( \
+ Perl_re_exec_indentf( aTHX_ \
"Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n",\
depth, (IV)(cp), (IV)PL_savestack_ix \
) \
/* Now restore the parentheses context. */
DEBUG_BUFFERS_r(
if (i || rex->lastparen + 1 <= rex->nparens)
- re_printf(
+ Perl_re_printf( aTHX_
"rex=0x%"UVxf" offs=0x%"UVxf": restoring capture indices to:\n",
PTR2UV(rex),
PTR2UV(rex->offs)
tmps = SSPOPIV;
if (paren <= rex->lastparen)
rex->offs[paren].end = tmps;
- DEBUG_BUFFERS_r( re_printf(
+ DEBUG_BUFFERS_r( Perl_re_printf( aTHX_
" \\%"UVuf": %"IVdf"(%"IVdf")..%"IVdf"%s\n",
(UV)paren,
(IV)rex->offs[paren].start,
if (i > *maxopenparen_p)
rex->offs[i].start = -1;
rex->offs[i].end = -1;
- DEBUG_BUFFERS_r( re_printf(
+ DEBUG_BUFFERS_r( Perl_re_printf( aTHX_
" \\%"UVuf": %s ..-1 undeffing\n",
(UV)i,
(i > *maxopenparen_p) ? "-1" : " "
PERL_UNUSED_ARG(flags);
PERL_UNUSED_ARG(data);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"Intuit: trying to determine minimum start position...\n"));
/* for now, assume that all substr offsets are positive. If at some point
* to quickly reject some cases that can't match, but will reject
* them later after doing full char arithmetic */
if (prog->minlen > strend - strpos) {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" String too short...\n"));
goto fail;
}
if (!sv)
continue;
- re_printf(
+ Perl_re_printf( aTHX_
" substrs[%d]: min=%"IVdf" max=%"IVdf" end shift=%"IVdf
" useful=%"IVdf" utf8=%d [%s]\n",
i,
if ( strpos != strbeg
&& (prog->intflags & PREGf_ANCH_SBOL))
{
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Not at start...\n"));
goto fail;
}
SSize_t slen = SvCUR(check);
char *s = HOP3c(strpos, prog->check_offset_min, strend);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Looking for check substr at fixed offset %"IVdf"...\n",
(IV)prog->check_offset_min));
|| strend - s < slen - 1
|| (strend - s == slen && strend[-1] != '\n')))
{
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" String too long...\n"));
goto fail_finish;
}
if (slen && (*SvPVX_const(check) != *s
|| (slen > 1 && memNE(SvPVX_const(check), s, slen))))
{
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" String not equal...\n"));
goto fail_finish;
}
U8* end_point;
DEBUG_OPTIMISE_MORE_r({
- re_printf(
+ Perl_re_printf( aTHX_
" At restart: rx_origin=%"IVdf" Check offset min: %"IVdf
" Start shift: %"IVdf" End shift %"IVdf
" Real end Shift: %"IVdf"\n",
check_at = fbm_instr( start_point, end_point,
check, multiline ? FBMrf_MULTILINE : 0);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" doing 'check' fbm scan, [%"IVdf"..%"IVdf"] gave %"IVdf"\n",
(IV)((char*)start_point - strbeg),
(IV)((char*)end_point - strbeg),
DEBUG_EXECUTE_r({
RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
SvPVX_const(check), RE_SV_DUMPLEN(check), 30);
- re_printf( " %s %s substr %s%s%s",
+ Perl_re_printf( aTHX_ " %s %s substr %s%s%s",
(check_at ? "Found" : "Did not find"),
(check == (utf8_target ? prog->anchored_utf8 : prog->anchored_substr)
? "anchored" : "floating"),
if (check_at - rx_origin > prog->check_offset_max)
rx_origin = HOP3c(check_at, -prog->check_offset_max, rx_origin);
/* Finish the diagnostic message */
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"%ld (rx_origin now %"IVdf")...\n",
(long)(check_at - strbeg),
(IV)(rx_origin - strbeg)
if (from > to) {
s = NULL;
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" skipping 'other' fbm scan: %"IVdf" > %"IVdf"\n",
(IV)(from - strbeg),
(IV)(to - strbeg)
must,
multiline ? FBMrf_MULTILINE : 0
);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" doing 'other' fbm scan, [%"IVdf"..%"IVdf"] gave %"IVdf"\n",
(IV)(from - strbeg),
(IV)(to - strbeg),
DEBUG_EXECUTE_r({
RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
- re_printf( " %s %s substr %s%s",
+ Perl_re_printf( aTHX_ " %s %s substr %s%s",
s ? "Found" : "Contradicts",
other_ix ? "floating" : "anchored",
quoted, RE_SV_TAIL(must));
/* last1 is latest possible substr location. If we didn't
* find it before there, we never will */
if (last >= last1) {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"; giving up...\n"));
goto fail_finish;
}
other_ix /* i.e. if other-is-float */
? HOP3c(rx_origin, 1, strend)
: HOP4c(last, 1 - other->min_offset, strbeg, strend);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"; about to retry %s at offset %ld (rx_origin now %"IVdf")...\n",
(other_ix ? "floating" : "anchored"),
(long)(HOP3c(check_at, 1, strend) - strbeg),
rx_origin = HOP3c(s, -other->min_offset, strbeg);
other_last = HOP3c(s, 1, strend);
}
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" at offset %ld (rx_origin now %"IVdf")...\n",
(long)(s - strbeg),
(IV)(rx_origin - strbeg)
}
else {
DEBUG_OPTIMISE_MORE_r(
- re_printf(
+ Perl_re_printf( aTHX_
" Check-only match: offset min:%"IVdf" max:%"IVdf
" check_at:%"IVdf" rx_origin:%"IVdf" rx_origin-check_at:%"IVdf
" strend:%"IVdf"\n",
if (ml_anch && rx_origin != strbeg && rx_origin[-1] != '\n') {
char *s;
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" looking for /^/m anchor"));
/* we have failed the constraint of a \n before rx_origin.
if (s <= rx_origin ||
! ( rx_origin = (char *)memchr(rx_origin, '\n', s - rx_origin)))
{
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Did not find /%s^%s/m...\n",
PL_colors[0], PL_colors[1]));
goto fail_finish;
/* Position contradicts check-string; either because
* check was anchored (and thus has no wiggle room),
* or check was float and rx_origin is above the float range */
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Found /%s^%s/m, about to restart lookup for check-string with rx_origin %ld...\n",
PL_colors[0], PL_colors[1], (long)(rx_origin - strbeg)));
goto restart;
* contradict. On the other hand, the float "check" substr
* didn't contradict, so just retry the anchored "other"
* substr */
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Found /%s^%s/m, rescanning for anchored from offset %"IVdf" (rx_origin now %"IVdf")...\n",
PL_colors[0], PL_colors[1],
(IV)(rx_origin - strbeg + prog->anchored_offset),
/* success: we don't contradict the found floating substring
* (and there's no anchored substr). */
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Found /%s^%s/m with rx_origin %ld...\n",
PL_colors[0], PL_colors[1], (long)(rx_origin - strbeg)));
}
else {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" (multiline anchor test skipped)\n"));
}
else
endpos= strend;
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" looking for class: start_shift: %"IVdf" check_at: %"IVdf
" rx_origin: %"IVdf" endpos: %"IVdf"\n",
(IV)start_shift, (IV)(check_at - strbeg),
reginfo);
if (!s) {
if (endpos == strend) {
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" Could not match STCLASS...\n") );
goto fail;
}
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" This position contradicts STCLASS...\n") );
if ((prog->intflags & PREGf_ANCH) && !ml_anch
&& !(prog->intflags & PREGf_IMPLICIT))
* an extra anchored search may get done, but in
* practice the extra fbm_instr() is likely to
* get skipped anyway. */
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" about to retry anchored at offset %ld (rx_origin now %"IVdf")...\n",
(long)(other_last - strbeg),
(IV)(rx_origin - strbeg)
* but since we goto a block of code that's going to
* search for the next \n if any, its safe here */
rx_origin++;
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" about to look for /%s^%s/m starting at rx_origin %ld...\n",
PL_colors[0], PL_colors[1],
(long)(rx_origin - strbeg)) );
* It's conservative: it errs on the side of doing 'goto restart',
* where there is code that does a proper char-based test */
if (rx_origin + start_shift + end_shift > strend) {
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" Could not match STCLASS...\n") );
goto fail;
}
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
" about to look for %s substr starting at offset %ld (rx_origin now %"IVdf")...\n",
(prog->substrs->check_ix ? "floating" : "anchored"),
(long)(rx_origin + start_shift - strbeg),
/* Success !!! */
if (rx_origin != s) {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" By STCLASS: moving %ld --> %ld\n",
(long)(rx_origin - strbeg), (long)(s - strbeg))
);
}
else {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
" Does not contradict STCLASS...\n");
);
}
/* Fixed substring is found far enough so that the match
cannot start at strpos. */
- DEBUG_EXECUTE_r(re_printf( " try at offset...\n"));
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ " try at offset...\n"));
++BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr); /* hooray/5 */
}
else {
)))
{
/* If flags & SOMETHING - do not do it many times on the same match */
- DEBUG_EXECUTE_r(re_printf( " ... Disabling check substring...\n"));
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ " ... Disabling check substring...\n"));
/* XXX Does the destruction order has to change with utf8_target? */
SvREFCNT_dec(utf8_target ? prog->check_utf8 : prog->check_substr);
SvREFCNT_dec(utf8_target ? prog->check_substr : prog->check_utf8);
}
}
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"Intuit: %sSuccessfully guessed:%s match at offset %ld\n",
PL_colors[4], PL_colors[5], (long)(rx_origin - strbeg)) );
if (prog->check_substr || prog->check_utf8) /* could be removed already */
BmUSEFUL(utf8_target ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
fail:
- DEBUG_EXECUTE_r(re_printf( "%sMatch rejected by optimizer%s\n",
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ "%sMatch rejected by optimizer%s\n",
PL_colors[4], PL_colors[5]));
return NULL;
}
if ( uc <= (U8*)last_start && !BITMAP_TEST(bitmap,*uc) ) {
dump_exec_pos( (char *)uc, c, strend, real_start,
(char *)uc, utf8_target, 0 );
- re_printf(
+ Perl_re_printf( aTHX_
" Scanning for legal start char...\n");
}
);
DEBUG_TRIE_EXECUTE_r({
dump_exec_pos( (char *)uc, c, strend,
real_start, s, utf8_target, 0);
- re_printf(
+ Perl_re_printf( aTHX_
" Charid:%3u CP:%4"UVxf" ",
charid, uvc);
});
if (failed)
dump_exec_pos( (char *)uc, c, strend, real_start,
s, utf8_target, 0 );
- re_printf(
+ Perl_re_printf( aTHX_
"%sState: %4"UVxf", word=%"UVxf,
failed ? " Fail transition to " : "",
(UV)state, (UV)word);
&& (tmp=trie->trans[offset].next))
{
DEBUG_TRIE_EXECUTE_r(
- re_printf(" - legal\n"));
+ Perl_re_printf( aTHX_ " - legal\n"));
state = tmp;
break;
}
else {
DEBUG_TRIE_EXECUTE_r(
- re_printf(" - fail\n"));
+ Perl_re_printf( aTHX_ " - fail\n"));
failed = 1;
state = aho->fail[state];
}
else {
/* we must be accepting here */
DEBUG_TRIE_EXECUTE_r(
- re_printf(" - accepting\n"));
+ Perl_re_printf( aTHX_ " - accepting\n"));
failed = 1;
break;
}
if (leftmost) {
s = (char*)leftmost;
DEBUG_TRIE_EXECUTE_r({
- re_printf( "Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
+ Perl_re_printf( aTHX_ "Matches word #%"UVxf" at position %"IVdf". Trying full pattern...\n",
(UV)accepted_word, (IV)(s - real_start)
);
});
}
s = HOPc(s,1);
DEBUG_TRIE_EXECUTE_r({
- re_printf("Pattern failed. Looking for new start point...\n");
+ Perl_re_printf( aTHX_ "Pattern failed. Looking for new start point...\n");
});
} else {
DEBUG_TRIE_EXECUTE_r(
- re_printf("No match.\n"));
+ Perl_re_printf( aTHX_ "No match.\n"));
break;
}
}
#ifdef PERL_ANY_COW
if (SvCANCOW(sv)) {
if (DEBUG_C_TEST) {
- re_printf(
+ Perl_re_printf( aTHX_
"Copy on write: regexp capture, type %d\n",
(int) SvTYPE(sv));
}
? strbeg + MgBYTEPOS(mg, sv, strbeg, strend-strbeg)
: strbeg; /* pos() not defined; use start of string */
- DEBUG_GPOS_r(re_printf(
+ DEBUG_GPOS_r(Perl_re_printf( aTHX_
"GPOS ganch set to strbeg[%"IVdf"]\n", (IV)(reginfo->ganch - strbeg)));
/* in the presence of \G, we may need to start looking earlier in
if (!startpos ||
((flags & REXEC_FAIL_ON_UNDERFLOW) && startpos < stringarg))
{
- DEBUG_r(re_printf(
+ DEBUG_r(Perl_re_printf( aTHX_
"fail: ganch-gofs before earliest possible start\n"));
return 0;
}
minlen = prog->minlen;
if ((startpos + minlen) > strend || startpos < strbeg) {
- DEBUG_r(re_printf(
+ DEBUG_r(Perl_re_printf( aTHX_
"Regex match can't succeed, so not even tried\n"));
return 0;
}
{
/* this should only be possible under \G */
assert(prog->intflags & PREGf_GPOS_SEEN);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"matched, but failing for REXEC_FAIL_ON_UNDERFLOW\n"));
goto phooey;
}
multiline = prog->extflags & RXf_PMf_MULTILINE;
if (strend - s < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"String too short [regexec_flags]...\n"));
goto phooey;
}
swap = prog->offs;
/* do we need a save destructor here for eval dies? */
Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
- DEBUG_BUFFERS_r(re_printf(
+ DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
"rex=0x%"UVxf" saving offs: orig=0x%"UVxf" new=0x%"UVxf"\n",
PTR2UV(prog),
PTR2UV(swap),
);
}
DEBUG_EXECUTE_r(if (!did_match)
- re_printf(
+ Perl_re_printf( aTHX_
"Did not find anchored character...\n")
);
}
DEBUG_EXECUTE_r(if (!did_match) {
RE_PV_QUOTED_DECL(quoted, utf8_target, PERL_DEBUG_PAD_ZERO(0),
SvPVX_const(must), RE_SV_DUMPLEN(must), 30);
- re_printf( "Did not find %s substr %s%s...\n",
+ Perl_re_printf( aTHX_ "Did not find %s substr %s%s...\n",
((must == prog->anchored_substr || must == prog->anchored_utf8)
? "anchored" : "floating"),
quoted, RE_SV_TAIL(must));
{
RE_PV_QUOTED_DECL(quoted,utf8_target,PERL_DEBUG_PAD_ZERO(1),
s,strend-s,60);
- re_printf(
+ Perl_re_printf( aTHX_
"Matching stclass %.*s against %s (%d bytes)\n",
(int)SvCUR(prop), SvPVX_const(prop),
quoted, (int)(strend - s));
});
if (find_byclass(prog, c, s, strend, reginfo))
goto got_it;
- DEBUG_EXECUTE_r(re_printf( "Contradicts stclass... [regexec_flags]\n"));
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ "Contradicts stclass... [regexec_flags]\n"));
}
else {
dontbother = 0;
* the \n. */
char *checkpos= strend - len;
DEBUG_OPTIMISE_r(
- re_printf(
+ Perl_re_printf( aTHX_
"%sChecking for float_real.%s\n",
PL_colors[4], PL_colors[5]));
if (checkpos + 1 < strbeg) {
/* can't match, even if we remove the trailing \n
* string is too short to match */
DEBUG_EXECUTE_r(
- re_printf(
+ Perl_re_printf( aTHX_
"%sString shorter than required trailing substring, cannot match.%s\n",
PL_colors[4], PL_colors[5]));
goto phooey;
/* cant match, string is too short when the "\n" is
* included */
DEBUG_EXECUTE_r(
- re_printf(
+ Perl_re_printf( aTHX_
"%sString does not contain required trailing substring, cannot match.%s\n",
PL_colors[4], PL_colors[5]));
goto phooey;
last= checkpos;
} else {
DEBUG_EXECUTE_r(
- re_printf(
+ Perl_re_printf( aTHX_
"%sString does not contain required trailing substring, cannot match.%s\n",
PL_colors[4], PL_colors[5]));
goto phooey;
* pretty sure it is not anymore, so I have removed the comment
* and replaced it with this one. Yves */
DEBUG_EXECUTE_r(
- re_printf(
+ Perl_re_printf( aTHX_
"%sString does not contain required substring, cannot match.%s\n",
PL_colors[4], PL_colors[5]
));
{
/* this should only be possible under \G */
assert(prog->intflags & PREGf_GPOS_SEEN);
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"matched, but failing for REXEC_FAIL_ON_UNDERFLOW\n"));
goto phooey;
}
DEBUG_BUFFERS_r(
if (swap)
- re_printf(
+ Perl_re_printf( aTHX_
"rex=0x%"UVxf" freeing offs: 0x%"UVxf"\n",
PTR2UV(prog),
PTR2UV(swap)
return 1;
phooey:
- DEBUG_EXECUTE_r(re_printf( "%sMatch failed%s\n",
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ "%sMatch failed%s\n",
PL_colors[4], PL_colors[5]));
/* clean up; this will trigger destructors that will free all slabs
if (swap) {
/* we failed :-( roll it back */
- DEBUG_BUFFERS_r(re_printf(
+ DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
"rex=0x%"UVxf" rolling back offs: freeing=0x%"UVxf" restoring=0x%"UVxf"\n",
PTR2UV(prog),
PTR2UV(prog->offs),
#define DEBUG_STATE_pp(pp) \
DEBUG_STATE_r({ \
DUMP_EXEC_POS(locinput, scan, utf8_target,depth); \
- re_printf( \
+ Perl_re_printf( aTHX_ \
"%*s" pp " %s%s%s%s%s\n", \
INDENT_CHARS(depth), "", \
PL_reg_name[st->resume_state], \
RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1),
start, end - start, 60);
- re_printf(
+ Perl_re_printf( aTHX_
"%s%s REx%s %s against %s\n",
PL_colors[4], blurb, PL_colors[5], s0, s1);
if (utf8_target||utf8_pat)
- re_printf( "UTF-8 %s%s%s...\n",
+ Perl_re_printf( aTHX_ "UTF-8 %s%s%s...\n",
utf8_pat ? "pattern" : "",
utf8_pat && utf8_target ? " and " : "",
utf8_target ? "string" : ""
locinput, loc_regeol - locinput, 10, 0, 1);
const STRLEN tlen=len0+len1+len2;
- re_printf(
+ Perl_re_printf( aTHX_
"%4"IVdf" <%.*s%.*s%s%.*s>%*s|%4u| ",
(IV)(locinput - loc_bostr),
len0, s0,
}
#ifdef DEBUGGING
- re_printf( "Unhandled LB pair: LB_table[%d, %d] = %d\n",
+ Perl_re_printf( aTHX_ "Unhandled LB pair: LB_table[%d, %d] = %d\n",
before, after, LB_table[before][after]);
assert(0);
#endif
}
#ifdef DEBUGGING
- re_printf( "Unhandled WB pair: WB_table[%d, %d] = %d\n",
+ Perl_re_printf( aTHX_ "Unhandled WB pair: WB_table[%d, %d] = %d\n",
before, after, WB_table[before][after]);
assert(0);
#endif
PERL_ARGS_ASSERT_REGMATCH;
DEBUG_OPTIMISE_r( DEBUG_EXECUTE_r({
- re_printf("regmatch start\n");
+ Perl_re_printf( aTHX_ "regmatch start\n");
}));
st = PL_regmatch_state;
DUMP_EXEC_POS( locinput, scan, utf8_target, depth );
regprop(rex, prop, scan, reginfo, NULL);
- re_printf(
+ Perl_re_printf( aTHX_
"%*s%"IVdf":%s(%"IVdf")\n",
INDENT_CHARS(depth), "",
(IV)(scan - rexi->program),
*/
if(!NEXTCHR_IS_EOS && !ANYOF_BITMAP_TEST(scan, nextchr)) {
DEBUG_EXECUTE_r(
- re_exec_indentf( "%sfailed to match trie start class...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sfailed to match trie start class...%s\n",
depth, PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
{
if (trie->states[ state ].wordnum) {
DEBUG_EXECUTE_r(
- re_exec_indentf( "%smatched empty string...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%smatched empty string...%s\n",
depth, PL_colors[4], PL_colors[5])
);
if (!trie->jump)
break;
} else {
DEBUG_EXECUTE_r(
- re_exec_indentf( "%sfailed to match trie start class...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sfailed to match trie start class...%s\n",
depth, PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
DEBUG_TRIE_EXECUTE_r({
DUMP_EXEC_POS( (char *)uc, scan, utf8_target, depth );
- re_exec_indentf(
+ Perl_re_exec_indentf( aTHX_
"%sState: %4"UVxf" Accepted: %c ",
depth, PL_colors[4],
(UV)state, (accepted ? 'Y' : 'N'));
state = 0;
}
DEBUG_TRIE_EXECUTE_r(
- re_printf(
+ Perl_re_printf( aTHX_
"Charid:%3x CP:%4"UVxf" After State: %4"UVxf"%s\n",
charid, uvc, (UV)state, PL_colors[5] );
);
}
DEBUG_EXECUTE_r(
- re_exec_indentf( "%sgot %"IVdf" possible matches%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sgot %"IVdf" possible matches%s\n",
depth,
PL_colors[4], (IV)ST.accepted, PL_colors[5] );
);
}
if (!--ST.accepted) {
DEBUG_EXECUTE_r({
- re_exec_indentf( "%sTRIE failed...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sTRIE failed...%s\n",
depth,
PL_colors[4],
PL_colors[5] );
: NEXT_OFF(ST.me));
DEBUG_EXECUTE_r({
- re_exec_indentf( "%sTRIE matched word #%d, continuing%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sTRIE matched word #%d, continuing%s\n",
depth,
PL_colors[4],
ST.nextword,
? av_fetch(trie_words, ST.nextword - 1, 0) : NULL;
SV *sv= tmp ? sv_newmortal() : NULL;
- re_exec_indentf( "%sonly one match left, short-circuiting: #%d <%s>%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sonly one match left, short-circuiting: #%d <%s>%s\n",
depth, PL_colors[4],
ST.nextword,
tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0,
DEBUG_r({
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_STACK_r({
- re_exec_indentf(
+ Perl_re_exec_indentf( aTHX_
"entering GOSUB, prev_recurse_locinput=%p recurse_locinput[%d]=%p\n",
depth, ST.prev_recurse_locinput, arg, rex->recurse_locinput[arg]
);
}
nop = nop->op_next;
- DEBUG_STATE_r( re_printf(
+ DEBUG_STATE_r( Perl_re_printf( aTHX_
" re EVAL PL_op=0x%"UVxf"\n", PTR2UV(nop)) );
rex->offs[0].end = locinput - reginfo->strbeg;
case EVAL_AB: /* cleanup after a successful (??{A})B */
DEBUG_STACK_r({
- re_exec_indentf( "EVAL_AB cur_eval=%p prev_eval=%p\n",
+ Perl_re_exec_indentf( aTHX_ "EVAL_AB cur_eval=%p prev_eval=%p\n",
depth, cur_eval, ST.prev_eval);
});
#define SET_RECURSE_LOCINPUT(STR,VAL)\
if ( cur_eval && CUR_EVAL.close_paren ) {\
DEBUG_EXECUTE_r({ \
- re_exec_indentf( "EVAL_AB[before] GOSUB%d ce=%p recurse_locinput=%p\n",\
+ Perl_re_exec_indentf( aTHX_ "EVAL_AB[before] GOSUB%d ce=%p recurse_locinput=%p\n",\
depth, \
CUR_EVAL.close_paren - 1,\
cur_eval, \
case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */
/* note: this is called twice; first after popping B, then A */
DEBUG_STACK_r({
- re_exec_indentf( "EVAL_AB_fail cur_eval=%p prev_eval=%p\n",
+ Perl_re_exec_indentf( aTHX_ "EVAL_AB_fail cur_eval=%p prev_eval=%p\n",
depth, cur_eval, ST.prev_eval);
});
rex->offs[n].start_tmp = locinput - reginfo->strbeg;
if (n > maxopenparen)
maxopenparen = n;
- DEBUG_BUFFERS_r(re_printf(
+ DEBUG_BUFFERS_r(Perl_re_printf( aTHX_
"rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf" tmp; maxopenparen=%"UVuf"\n",
PTR2UV(rex),
PTR2UV(rex->offs),
#define CLOSE_CAPTURE \
rex->offs[n].start = rex->offs[n].start_tmp; \
rex->offs[n].end = locinput - reginfo->strbeg; \
- DEBUG_BUFFERS_r(re_printf( \
+ DEBUG_BUFFERS_r(Perl_re_printf( aTHX_ \
"rex=0x%"UVxf" offs=0x%"UVxf": \\%"UVuf": set %"IVdf"..%"IVdf"\n", \
PTR2UV(rex), \
PTR2UV(rex->offs), \
ST.cache_mask = 0;
- DEBUG_EXECUTE_r( re_exec_indentf( "whilem: matched %ld out of %d..%d\n",
+ DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_ "whilem: matched %ld out of %d..%d\n",
depth, (long)n, min, max)
);
/* If degenerate A matches "", assume A done. */
if (locinput == cur_curlyx->u.curlyx.lastloc) {
- DEBUG_EXECUTE_r( re_exec_indentf( "whilem: empty match detected, trying continuation...\n",
+ DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_ "whilem: empty match detected, trying continuation...\n",
depth)
);
goto do_whilem_B_max;
reginfo->poscache_size = size;
Newxz(aux->poscache, size, char);
}
- DEBUG_EXECUTE_r( re_printf(
+ DEBUG_EXECUTE_r( Perl_re_printf( aTHX_
"%swhilem: Detected a super-linear match, switching on caching%s...\n",
PL_colors[4], PL_colors[5])
);
mask = 1 << (offset % 8);
offset /= 8;
if (reginfo->info_aux->poscache[offset] & mask) {
- DEBUG_EXECUTE_r( re_exec_indentf( "whilem: (cache) already tried at this position...\n",
+ DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_ "whilem: (cache) already tried at this position...\n",
depth)
);
sayNO; /* cache records failure */
case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
REGCP_UNWIND(ST.lastcp);
regcppop(rex, &maxopenparen); /* Restore some previous $<digit>s? */
- DEBUG_EXECUTE_r(re_exec_indentf( "whilem: failed, trying continuation...\n",
+ DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_ "whilem: failed, trying continuation...\n",
depth)
);
do_whilem_B_max:
CACHEsayNO;
}
- DEBUG_EXECUTE_r(re_exec_indentf( "trying longer...\n", depth)
+ DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_ "trying longer...\n", depth)
);
/* Try grabbing another A and see if it helps. */
cur_curlyx->u.curlyx.lastloc = locinput;
/* no more branches? */
if (!scan || (OP(scan) != BRANCH && OP(scan) != BRANCHJ)) {
DEBUG_EXECUTE_r({
- re_exec_indentf( "%sBRANCH failed...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sBRANCH failed...%s\n",
depth,
PL_colors[4],
PL_colors[5] );
ST.count = ST.minmod ? ARG1(ST.me) : ARG2(ST.me);
}
DEBUG_EXECUTE_r(
- re_exec_indentf( "CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM now matched %"IVdf" times, len=%"IVdf"...\n",
depth, (IV) ST.count, (IV)ST.alen)
);
}
DEBUG_EXECUTE_r(
- re_exec_indentf( "CURLYM trying tail with matches=%"IVdf"...\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM trying tail with matches=%"IVdf"...\n",
depth, (IV)ST.count)
);
if (! NEXTCHR_IS_EOS && ST.c1 != CHRTEST_VOID) {
{
/* simulate B failing */
DEBUG_OPTIMISE_r(
- re_exec_indentf( "CURLYM Fast bail next target=0x%"UVXf" c1=0x%"UVXf" c2=0x%"UVXf"\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM Fast bail next target=0x%"UVXf" c1=0x%"UVXf" c2=0x%"UVXf"\n",
depth,
valid_utf8_to_uvchr((U8 *) locinput, NULL),
valid_utf8_to_uvchr(ST.c1_utf8, NULL),
else if (nextchr != ST.c1 && nextchr != ST.c2) {
/* simulate B failing */
DEBUG_OPTIMISE_r(
- re_exec_indentf( "CURLYM Fast bail next target=0x%X c1=0x%X c2=0x%X\n",
+ Perl_re_exec_indentf( aTHX_ "CURLYM Fast bail next target=0x%X c1=0x%X c2=0x%X\n",
depth,
(int) nextchr, ST.c1, ST.c2)
);
st->u.eval.prev_eval = cur_eval;
cur_eval = CUR_EVAL.prev_eval;
DEBUG_EXECUTE_r(
- re_exec_indentf( "EVAL trying tail ... (cur_eval=%p)\n",
+ Perl_re_exec_indentf( aTHX_ "EVAL trying tail ... (cur_eval=%p)\n",
depth, cur_eval););
if ( nochange_depth )
nochange_depth--;
}
if (locinput < reginfo->till) {
- DEBUG_EXECUTE_r(re_printf(
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_
"%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
PL_colors[4],
(long)(locinput - startpos),
case SUCCEED: /* successful SUSPEND/UNLESSM/IFMATCH/CURLYM */
DEBUG_EXECUTE_r(
- re_exec_indentf( "%ssubpattern success...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%ssubpattern success...%s\n",
depth, PL_colors[4], PL_colors[5]));
sayYES; /* Success! */
sv_commit = ST.mark_name;
DEBUG_EXECUTE_r({
- re_exec_indentf( "%ssetting cutpoint to mark:%"SVf"...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%ssetting cutpoint to mark:%"SVf"...%s\n",
depth,
PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
});
slab = slab->prev;
cur = SLAB_LAST(slab);
}
- re_exec_indentf("#%-3d %-10s %s\n",
+ Perl_re_exec_indentf( aTHX_ "#%-3d %-10s %s\n",
depth,
curd, PL_reg_name[cur->resume_state],
(curyes == cur) ? "yes" : ""
goto reenter_switch;
}
- DEBUG_EXECUTE_r(re_printf( "%sMatch successful!%s\n",
+ DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ "%sMatch successful!%s\n",
PL_colors[4], PL_colors[5]));
if (reginfo->info_aux_eval) {
no:
DEBUG_EXECUTE_r(
- re_exec_indentf( "%sfailed...%s\n",
+ Perl_re_exec_indentf( aTHX_ "%sfailed...%s\n",
depth,
PL_colors[4], PL_colors[5])
);
DEBUG_EXECUTE_r({
SV * const prop = sv_newmortal();
regprop(prog, prop, p, reginfo, NULL);
- re_exec_indentf( "%s can match %"IVdf" times out of %"IVdf"...\n",
+ Perl_re_exec_indentf( aTHX_ "%s can match %"IVdf" times out of %"IVdf"...\n",
depth, SvPVX_const(prop),(IV)c,(IV)max);
});
});
https://perl5.git.perl.org / perl5.git / commitdiff