X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/cb41e5d6f2193df9fd06cf60a96285694ec458ba..b084bc872b1f5913720822fd8869b542ba5ef81e:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 64a8021..646cf38 100644 --- a/regcomp.c +++ b/regcomp.c @@ -502,7 +502,20 @@ static const scan_data_t zero_scan_data = #define SF_HAS_PAR 0x0080 #define SF_IN_PAR 0x0100 #define SF_HAS_EVAL 0x0200 + + +/* SCF_DO_SUBSTR is the flag that tells the regexp analyzer to track the + * longest substring in the pattern. When it is not set the optimiser keeps + * track of position, but does not keep track of the actual strings seen, + * + * So for instance /foo/ will be parsed with SCF_DO_SUBSTR being true, but + * /foo/i will not. + * + * Similarly, /foo.*(blah|erm|huh).*fnorble/ will have "foo" and "fnorble" + * parsed with SCF_DO_SUBSTR on, but while processing the (...) it will be + * turned off because of the alternation (BRANCH). */ #define SCF_DO_SUBSTR 0x0400 + #define SCF_DO_STCLASS_AND 0x0800 #define SCF_DO_STCLASS_OR 0x1000 #define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR) @@ -900,7 +913,7 @@ static const scan_data_t zero_scan_data = #ifdef DEBUGGING int -Perl_re_printf(const char *fmt, ...) +Perl_re_printf(pTHX_ const char *fmt, ...) { va_list ap; int result; @@ -913,7 +926,7 @@ Perl_re_printf(const char *fmt, ...) } int -Perl_re_indentf(const char *fmt, U32 depth, ...) +Perl_re_indentf(pTHX_ const char *fmt, U32 depth, ...) { va_list ap; int result; @@ -927,49 +940,49 @@ Perl_re_indentf(const char *fmt, U32 depth, ...) } #endif /* DEBUGGING */ -#define DEBUG_RExC_seen() \ +#define DEBUG_RExC_seen() \ DEBUG_OPTIMISE_MORE_r({ \ - Perl_re_printf("RExC_seen: "); \ + Perl_re_printf( aTHX_ "RExC_seen: "); \ \ if (RExC_seen & REG_ZERO_LEN_SEEN) \ - Perl_re_printf("REG_ZERO_LEN_SEEN "); \ + Perl_re_printf( aTHX_ "REG_ZERO_LEN_SEEN "); \ \ if (RExC_seen & REG_LOOKBEHIND_SEEN) \ - Perl_re_printf("REG_LOOKBEHIND_SEEN "); \ + Perl_re_printf( aTHX_ "REG_LOOKBEHIND_SEEN "); \ \ if (RExC_seen & REG_GPOS_SEEN) \ - Perl_re_printf("REG_GPOS_SEEN "); \ + Perl_re_printf( aTHX_ "REG_GPOS_SEEN "); \ \ if (RExC_seen & REG_RECURSE_SEEN) \ - Perl_re_printf("REG_RECURSE_SEEN "); \ + Perl_re_printf( aTHX_ "REG_RECURSE_SEEN "); \ \ - if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \ - Perl_re_printf("REG_TOP_LEVEL_BRANCHES_SEEN "); \ + if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \ + Perl_re_printf( aTHX_ "REG_TOP_LEVEL_BRANCHES_SEEN "); \ \ if (RExC_seen & REG_VERBARG_SEEN) \ - Perl_re_printf("REG_VERBARG_SEEN "); \ + Perl_re_printf( aTHX_ "REG_VERBARG_SEEN "); \ \ if (RExC_seen & REG_CUTGROUP_SEEN) \ - Perl_re_printf("REG_CUTGROUP_SEEN "); \ + Perl_re_printf( aTHX_ "REG_CUTGROUP_SEEN "); \ \ if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \ - Perl_re_printf("REG_RUN_ON_COMMENT_SEEN "); \ + Perl_re_printf( aTHX_ "REG_RUN_ON_COMMENT_SEEN "); \ \ if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \ - Perl_re_printf("REG_UNFOLDED_MULTI_SEEN "); \ + Perl_re_printf( aTHX_ "REG_UNFOLDED_MULTI_SEEN "); \ \ - if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \ - Perl_re_printf("REG_UNBOUNDED_QUANTIFIER_SEEN "); \ + if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \ + Perl_re_printf( aTHX_ "REG_UNBOUNDED_QUANTIFIER_SEEN "); \ \ - Perl_re_printf("\n"); \ + Perl_re_printf( aTHX_ "\n"); \ }); #define DEBUG_SHOW_STUDY_FLAG(flags,flag) \ - if ((flags) & flag) Perl_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 ) ) { \ - Perl_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); \ @@ -985,28 +998,28 @@ Perl_re_indentf(const char *fmt, U32 depth, ...) 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); \ - Perl_re_printf( "%s", close_str); \ + Perl_re_printf( aTHX_ "%s", close_str); \ } #define DEBUG_STUDYDATA(str,data,depth) \ DEBUG_OPTIMISE_MORE_r(if(data){ \ - Perl_re_indentf( "" str "Pos:%"IVdf"/%"IVdf \ + Perl_re_indentf( aTHX_ "" str "Pos:%"IVdf"/%"IVdf \ " Flags: 0x%"UVXf, \ - depth, \ + depth, \ (IV)((data)->pos_min), \ (IV)((data)->pos_delta), \ (UV)((data)->flags) \ ); \ DEBUG_SHOW_STUDY_FLAGS((data)->flags," [ ","]"); \ - Perl_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) \ - Perl_re_printf( \ + Perl_re_printf( aTHX_ \ "Last:'%s' %"IVdf":%"IVdf"/%"IVdf" %sFixed:'%s' @ %"IVdf \ " %sFloat: '%s' @ %"IVdf"/%"IVdf"", \ SvPVX_const((data)->last_found), \ @@ -1023,7 +1036,7 @@ DEBUG_OPTIMISE_MORE_r(if(data){ \ (IV)((data)->offset_float_min), \ (IV)((data)->offset_float_max) \ ); \ - Perl_re_printf("\n"); \ + Perl_re_printf( aTHX_ "\n"); \ }); @@ -1977,14 +1990,13 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, PERL_ARGS_ASSERT_DUMP_TRIE; - Perl_re_indentf( "Char : %-6s%-6s%-4s ", - depth+1, - "Match","Base","Ofs" ); + 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 ) { - Perl_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], @@ -1994,27 +2006,25 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, ); } } - Perl_re_printf( "\n%*sState|-----------------------", - depth+1); + Perl_re_printf( aTHX_ "\n"); + Perl_re_indentf( aTHX_ "State|-----------------------", depth+1); for( state = 0 ; state < trie->uniquecharcount ; state++ ) - Perl_re_printf( "%.*s", colwidth, "--------"); - Perl_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; - Perl_re_indentf( "#%4"UVXf"|", - depth+1, (UV)state); + Perl_re_indentf( aTHX_ "#%4"UVXf"|", depth+1, (UV)state); if ( trie->states[ state ].wordnum ) { - Perl_re_printf( " W%4X", - trie->states[ state ].wordnum ); + Perl_re_printf( aTHX_ " W%4X", trie->states[ state ].wordnum ); } else { - Perl_re_printf( "%6s", "" ); + Perl_re_printf( aTHX_ "%6s", "" ); } - Perl_re_printf( " @%4"UVXf" ", (UV)base ); + Perl_re_printf( aTHX_ " @%4"UVXf" ", (UV)base ); if ( base ) { U32 ofs = 0; @@ -2025,7 +2035,7 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, != state)) ofs++; - Perl_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 ) @@ -2034,28 +2044,27 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, && trie->trans[ base + ofs - trie->uniquecharcount ].check == state ) { - Perl_re_printf( "%*"UVXf, - colwidth, - (UV)trie->trans[ base + ofs - - trie->uniquecharcount ].next ); + Perl_re_printf( aTHX_ "%*"UVXf, colwidth, + (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next + ); } else { - Perl_re_printf( "%*s",colwidth," ." ); + Perl_re_printf( aTHX_ "%*s",colwidth," ." ); } } - Perl_re_printf( "]"); + Perl_re_printf( aTHX_ "]"); } - Perl_re_printf( "\n" ); + Perl_re_printf( aTHX_ "\n" ); } - Perl_re_indentf( "word_info N:(prev,len)=", + Perl_re_indentf( aTHX_ "word_info N:(prev,len)=", depth); for (word=1; word <= trie->wordcount; word++) { - Perl_re_printf( " %d:(%d,%d)", + Perl_re_printf( aTHX_ " %d:(%d,%d)", (int)word, (int)(trie->wordinfo[word].prev), (int)(trie->wordinfo[word].len)); } - Perl_re_printf( "\n" ); + Perl_re_printf( aTHX_ "\n" ); } /* Dumps a fully constructed but uncompressed trie in list form. @@ -2076,20 +2085,20 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST; /* print out the table precompression. */ - Perl_re_indentf( "State :Word | Transition Data\n", + Perl_re_indentf( aTHX_ "State :Word | Transition Data\n", depth+1 ); - Perl_re_indentf( "%s", + Perl_re_indentf( aTHX_ "%s", depth+1, "------:-----+-----------------\n" ); for( state=1 ; state < next_alloc ; state ++ ) { U16 charid; - Perl_re_indentf( " %4"UVXf" :", + Perl_re_indentf( aTHX_ " %4"UVXf" :", depth+1, (UV)state ); if ( ! trie->states[ state ].wordnum ) { - Perl_re_printf( "%5s| ",""); + Perl_re_printf( aTHX_ "%5s| ",""); } else { - Perl_re_printf( "W%4x| ", + Perl_re_printf( aTHX_ "W%4x| ", trie->states[ state ].wordnum ); } @@ -2097,7 +2106,7 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0); if ( tmp ) { - Perl_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, @@ -2109,11 +2118,11 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, (UV)TRIE_LIST_ITEM(state,charid).newstate ); if (!(charid % 10)) - Perl_re_printf( "\n%*s| ", + Perl_re_printf( aTHX_ "\n%*s| ", (int)((depth * 2) + 14), ""); } } - Perl_re_printf( "\n"); + Perl_re_printf( aTHX_ "\n"); } } @@ -2141,12 +2150,12 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, that they are identical. */ - Perl_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 ) { - Perl_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], @@ -2157,32 +2166,32 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, } } - Perl_re_printf( "\n%*sState+-",depth+1 ); + Perl_re_printf( aTHX_ "\n%*sState+-",depth+1 ); for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) { - Perl_re_printf( "%.*s", colwidth,"--------"); + Perl_re_printf( aTHX_ "%.*s", colwidth,"--------"); } - Perl_re_printf( "\n" ); + Perl_re_printf( aTHX_ "\n" ); for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) { - Perl_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) - Perl_re_printf( "%*"UVXf, colwidth, v ); + Perl_re_printf( aTHX_ "%*"UVXf, colwidth, v ); else - Perl_re_printf( "%*s", colwidth, "." ); + Perl_re_printf( aTHX_ "%*s", colwidth, "." ); } if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) { - Perl_re_printf( " (%4"UVXf")\n", + Perl_re_printf( aTHX_ " (%4"UVXf")\n", (UV)trie->trans[ state ].check ); } else { - Perl_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 ); } @@ -2494,7 +2503,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT); } DEBUG_TRIE_COMPILE_r({ - Perl_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), @@ -2701,7 +2710,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } } /* end first pass */ DEBUG_TRIE_COMPILE_r( - Perl_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, @@ -2751,7 +2760,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, STRLEN transcount = 1; - DEBUG_TRIE_COMPILE_MORE_r( Perl_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 *) @@ -2858,7 +2867,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, /* DEBUG_TRIE_COMPILE_MORE_r( - Perl_re_printf( "tp: %d zp: %d ",tp,zp) + Perl_re_printf( aTHX_ "tp: %d zp: %d ",tp,zp) ); */ @@ -2920,7 +2929,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } /* DEBUG_TRIE_COMPILE_MORE_r( - Perl_re_printf( " base: %d\n",base); + Perl_re_printf( aTHX_ " base: %d\n",base); ); */ trie->states[ state ].trans.base=base; @@ -2963,7 +2972,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, we have to use TRIE_NODENUM() to convert. */ - DEBUG_TRIE_COMPILE_MORE_r( Perl_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 *) @@ -3154,7 +3163,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, PerlMemShared_realloc( trie->states, laststate * sizeof(reg_trie_state) ); DEBUG_TRIE_COMPILE_MORE_r( - Perl_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 ), @@ -3166,7 +3175,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } /* end table compress */ } DEBUG_TRIE_COMPILE_MORE_r( - Perl_re_indentf( "Statecount:%"UVxf" Lasttrans:%"UVxf"\n", + Perl_re_indentf( aTHX_ "Statecount:%"UVxf" Lasttrans:%"UVxf"\n", depth+1, (UV)trie->statecount, (UV)trie->lasttrans) @@ -3217,7 +3226,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, }); } DEBUG_OPTIMISE_r( - Perl_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) ); @@ -3248,7 +3257,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if ( count == 2 ) { Zero(trie->bitmap, ANYOF_BITMAP_SIZE, char); DEBUG_OPTIMISE_r( - Perl_re_indentf( "New Start State=%"UVuf" Class: [", + Perl_re_indentf( aTHX_ "New Start State=%"UVuf" Class: [", depth+1, (UV)state)); if (idx >= 0) { @@ -3259,14 +3268,14 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if ( folder ) TRIE_BITMAP_SET(trie, folder[ *ch ]); DEBUG_OPTIMISE_r( - Perl_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(Perl_re_printf("%s", ch)); + DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "%s", ch)); } idx = ofs; } @@ -3277,7 +3286,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, char *ch = SvPV( *tmp, len ); DEBUG_OPTIMISE_r({ SV *sv=sv_newmortal(); - Perl_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, @@ -3298,7 +3307,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } else { #ifdef DEBUGGING if (state>1) - DEBUG_OPTIMISE_r(Perl_re_printf("]\n")); + DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "]\n")); #endif break; } @@ -3570,13 +3579,13 @@ S_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *sour */ fail[ 0 ] = fail[ 1 ] = 0; DEBUG_TRIE_COMPILE_r({ - Perl_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%3d: %s (%d)", \ +#define DEBUG_PEEP(str,scan,depth) \ + DEBUG_OPTIMISE_r({if (scan){ \ + regnode *Next = regnext(scan); \ + regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state);\ + Perl_re_indentf( aTHX_ "" str ">%3d: %s (%d)", \ depth, REG_NODE_NUM(scan), SvPV_nolen_const(RExC_mysv),\ - Next ? (REG_NODE_NUM(Next)) : 0 ); \ + Next ? (REG_NODE_NUM(Next)) : 0 );\ DEBUG_SHOW_STUDY_FLAGS(flags," [ ","]");\ - Perl_re_printf( "\n"); \ + Perl_re_printf( aTHX_ "\n"); \ }}); /* The below joins as many adjacent EXACTish nodes as possible into a single @@ -4106,7 +4115,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, ); DEBUG_OPTIMISE_MORE_r( { - Perl_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, @@ -4126,16 +4135,16 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, (( j - 1 ) * RExC_study_chunk_recursed_bytes), i) ) ) { - Perl_re_printf(" %d",(int)i); + Perl_re_printf( aTHX_ " %d",(int)i); break; } } if ( j + 1 < recursed_depth ) { - Perl_re_printf( ","); + Perl_re_printf( aTHX_ ","); } } } - Perl_re_printf("\n"); + Perl_re_printf( aTHX_ "\n"); } ); while ( scan && OP(scan) != END && scan < last ){ @@ -4148,9 +4157,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, DEBUG_PEEP("Peep", scan, depth); - /* The reason we do this here we need to deal with things like /(?:f)(?:o)(?:o)/ - * which cant be dealt with by the normal EXACT parsing code, as each (?:..) is handled - * by a different invocation of reg() -- Yves + /* The reason we do this here is that we need to deal with things like + * /(?:f)(?:o)(?:o)/ which cant be dealt with by the normal EXACT + * parsing code, as each (?:..) is handled by a different invocation of + * reg() -- Yves */ JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0); @@ -4411,7 +4421,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, DEBUG_TRIE_COMPILE_r({ regprop(RExC_rx, RExC_mysv, tail, NULL, pRExC_state); - Perl_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), @@ -4503,20 +4513,20 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, DEBUG_TRIE_COMPILE_r({ regprop(RExC_rx, RExC_mysv, cur, NULL, pRExC_state); - Perl_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); - Perl_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); - Perl_re_printf("\t=> %d:%s\t", + Perl_re_printf( aTHX_ "\t=> %d:%s\t", REG_NODE_NUM(noper_next), SvPV_nolen_const(RExC_mysv)); } - Perl_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] ); @@ -4612,9 +4622,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } /* loop over branches */ DEBUG_TRIE_COMPILE_r({ regprop(RExC_rx, RExC_mysv, cur, NULL, pRExC_state); - Perl_re_indentf( "- %s (%d) ", + Perl_re_indentf( aTHX_ "- %s (%d) ", depth+1, SvPV_nolen_const( RExC_mysv ),REG_NODE_NUM(cur)); - Perl_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] ); @@ -4654,7 +4664,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, * turn it into a plain NOTHING op. */ DEBUG_TRIE_COMPILE_r({ regprop(RExC_rx, RExC_mysv, cur, NULL, pRExC_state); - Perl_re_indentf( "- %s (%d) \n", + Perl_re_indentf( aTHX_ "- %s (%d) \n", depth+1, SvPV_nolen_const( RExC_mysv ),REG_NODE_NUM(cur)); @@ -5244,13 +5254,13 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, /* It is counted once already... */ data->pos_min += minnext * (mincount - counted); #if 0 -Perl_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) -Perl_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 @@ -6064,7 +6074,7 @@ Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags) /* Dispatch a request to compile a regexp to correct regexp engine. */ DEBUG_COMPILE_r({ - Perl_re_printf( "Using engine %"UVxf"\n", + Perl_re_printf( aTHX_ "Using engine %"UVxf"\n", PTR2UV(eng)); }); return CALLREGCOMP_ENG(eng, pattern, flags); @@ -6109,7 +6119,7 @@ S_pat_upgrade_to_utf8(pTHX_ RExC_state_t * const pRExC_state, bool do_end = 0; GET_RE_DEBUG_FLAGS_DECL; - DEBUG_PARSE_r(Perl_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); @@ -6477,7 +6487,7 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, *p++ = 'x'; *p++ = '\0'; DEBUG_COMPILE_r({ - Perl_re_printf( + Perl_re_printf( aTHX_ "%sre-parsing pattern for runtime code:%s %s\n", PL_colors[4],PL_colors[5],newpat); }); @@ -6812,7 +6822,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, } - DEBUG_PARSE_r(Perl_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" : "")); @@ -6841,7 +6851,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, *is_bare_re = TRUE; SvREFCNT_inc(re); Safefree(pRExC_state->code_blocks); - DEBUG_PARSE_r(Perl_re_printf( + DEBUG_PARSE_r(Perl_re_printf( aTHX_ "Precompiled pattern%s\n", orig_rx_flags & RXf_SPLIT ? " for split" : "")); @@ -6884,7 +6894,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, DEBUG_COMPILE_r({ SV *dsv= sv_newmortal(); RE_PV_QUOTED_DECL(s, RExC_utf8, dsv, exp, plen, 60); - Perl_re_printf( "%sCompiling REx%s %s\n", + Perl_re_printf( aTHX_ "%sCompiling REx%s %s\n", PL_colors[4],PL_colors[5],s); }); @@ -7000,7 +7010,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, assert(*RExC_end == '\0'); DEBUG_PARSE_r( - Perl_re_printf( "Starting first pass (sizing)\n"); + Perl_re_printf( aTHX_ "Starting first pass (sizing)\n"); RExC_lastnum=0; RExC_lastparse=NULL; ); @@ -7030,7 +7040,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, pRExC_state->num_code_blocks); } else { - DEBUG_PARSE_r(Perl_re_printf( + DEBUG_PARSE_r(Perl_re_printf( aTHX_ "Need to redo pass 1\n")); } @@ -7042,7 +7052,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, SvLEN_set(code_blocksv,0); /* no you can't have it, sv_clear */ DEBUG_PARSE_r({ - Perl_re_printf( + Perl_re_printf( aTHX_ "Required size %"IVdf" nodes\n" "Starting second pass (creation)\n", (IV)RExC_size); @@ -7180,7 +7190,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, /* Useful during FAIL. */ #ifdef RE_TRACK_PATTERN_OFFSETS Newxz(ri->u.offsets, 2*RExC_size+1, U32); /* MJD 20001228 */ - DEBUG_OFFSETS_r(Perl_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)))); @@ -7205,7 +7215,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, /* 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(Perl_re_printf( + DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_ "%*s%*s Setting up open/close parens\n", 22, "| |", (int)(0 * 2 + 1), "")); @@ -7238,7 +7248,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for generation pass, flags=%#"UVxf"", (UV) flags); } DEBUG_OPTIMISE_r( - Perl_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 @@ -7267,7 +7277,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, copyRExC_state = RExC_state; } else { U32 seen=RExC_seen; - DEBUG_OPTIMISE_r(Perl_re_printf("Restudying\n")); + DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "Restudying\n")); RExC_state = copyRExC_state; if (seen & REG_TOP_LEVEL_BRANCHES_SEEN) @@ -7401,12 +7411,12 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, #ifdef TRIE_STUDY_OPT DEBUG_PARSE_r( if (!restudied) - Perl_re_printf( "first at %"IVdf"\n", + Perl_re_printf( aTHX_ "first at %"IVdf"\n", (IV)(first - scan + 1)) ); #else DEBUG_PARSE_r( - Perl_re_printf( "first at %"IVdf"\n", + Perl_re_printf( aTHX_ "first at %"IVdf"\n", (IV)(first - scan + 1)) ); #endif @@ -7535,7 +7545,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, 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); - Perl_re_printf( + Perl_re_printf( aTHX_ "synthetic stclass \"%s\".\n", SvPVX_const(sv));}); data.start_class = NULL; @@ -7580,7 +7590,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, regnode_ssc ch_class; SSize_t last_close = 0; - DEBUG_PARSE_r(Perl_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); @@ -7615,7 +7625,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, 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); - Perl_re_printf( + Perl_re_printf( aTHX_ "synthetic stclass \"%s\".\n", SvPVX_const(sv));}); data.start_class = NULL; @@ -7633,7 +7643,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, /* Guard against an embedded (?=) or (?<=) with a longer minlen than the "real" pattern. */ DEBUG_OPTIMISE_r({ - Perl_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; @@ -7727,12 +7737,12 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, Newxz(r->offs, RExC_npar, regexp_paren_pair); /* assume we don't need to swap parens around before we match */ DEBUG_TEST_r({ - Perl_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(); - Perl_re_printf("Final program:\n"); + Perl_re_printf( aTHX_ "Final program:\n"); regdump(r); }); #ifdef RE_TRACK_PATTERN_OFFSETS @@ -7740,14 +7750,14 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, const STRLEN len = ri->u.offsets[0]; STRLEN i; GET_RE_DEBUG_FLAGS_DECL; - Perl_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]) - Perl_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]); } - Perl_re_printf( "\n"); + Perl_re_printf( aTHX_ "\n"); }); #endif @@ -8265,7 +8275,7 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) #define DEBUG_PARSE_MSG(funcname) DEBUG_PARSE_r({ \ int num; \ if (RExC_lastparse!=RExC_parse) { \ - Perl_re_printf( "%s", \ + Perl_re_printf( aTHX_ "%s", \ Perl_pv_pretty(aTHX_ RExC_mysv1, RExC_parse, \ RExC_end - RExC_parse, 16, \ "", "", \ @@ -8277,17 +8287,17 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) ) \ ); \ } else \ - Perl_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) \ - Perl_re_printf("|%4d",num); \ + Perl_re_printf( aTHX_ "|%4d",num); \ else \ - Perl_re_printf("|%4s",""); \ - Perl_re_printf("|%*s%-4s", \ + Perl_re_printf( aTHX_ "|%4s",""); \ + Perl_re_printf( aTHX_ "|%*s%-4s", \ (int)((depth*2)), "", \ (funcname) \ ); \ @@ -8299,11 +8309,11 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) #define DEBUG_PARSE(funcname) DEBUG_PARSE_r({ \ DEBUG_PARSE_MSG((funcname)); \ - Perl_re_printf("%4s","\n"); \ + Perl_re_printf( aTHX_ "%4s","\n"); \ }) -#define DEBUG_PARSE_FMT(funcname,fmt,args) DEBUG_PARSE_r({ \ +#define DEBUG_PARSE_FMT(funcname,fmt,args) DEBUG_PARSE_r({\ DEBUG_PARSE_MSG((funcname)); \ - Perl_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 @@ -10736,7 +10746,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) vFAIL("Reference to nonexistent group"); } RExC_recurse_count++; - DEBUG_OPTIMISE_MORE_r(Perl_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))); @@ -11049,7 +11059,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) RExC_nestroot = parno; if (RExC_open_parens && !RExC_open_parens[parno]) { - DEBUG_OPTIMISE_MORE_r(Perl_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))); @@ -11143,7 +11153,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) case 1: case 2: ender = reganode(pRExC_state, CLOSE, parno); if ( RExC_close_parens ) { - DEBUG_OPTIMISE_MORE_r(Perl_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; @@ -11168,7 +11178,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) assert(!RExC_end_op); /* there can only be one! */ RExC_end_op = ender; if (RExC_close_parens) { - DEBUG_OPTIMISE_MORE_r(Perl_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))); @@ -11181,7 +11191,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) DEBUG_PARSE_MSG("lsbr"); regprop(RExC_rx, RExC_mysv1, lastbr, NULL, pRExC_state); regprop(RExC_rx, RExC_mysv2, ender, NULL, pRExC_state); - Perl_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), @@ -11220,7 +11230,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) DEBUG_PARSE_MSG("NADA"); regprop(RExC_rx, RExC_mysv1, ret, NULL, pRExC_state); regprop(RExC_rx, RExC_mysv2, ender, NULL, pRExC_state); - Perl_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), @@ -14537,7 +14547,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, 'stack' of where the undealt-with left parens would be if they were actually put there */ - IV fence = 0; /* Position of where most recent undealt- + /* The 'VOL' (expanding to 'volatile') is a workaround for an optimiser bug + * in Solaris Studio 12.3. See RT #127455 */ + VOL IV fence = 0; /* Position of where most recent undealt- with left paren in stack is; -1 if none. */ STRLEN len; /* Temporary */ @@ -15142,21 +15154,7 @@ redo_curchar: * may have altered the stack in the time since we earlier set * 'top_index'. */ - { - /* Work round an optimiser bug in Solaris Studio 12.3: - * for some reason, the presence of the __assert() in - * av_tindex_nomg() causes the value of fence to get - * corrupted, even though the assert is never called. So - * save the value then restore afterwards. - * Note that in fact merely accessing the value of fence - * prior to the statement containing the assert is enough - * to make the bug go away. - */ - IV f = fence; - top_index = av_tindex_nomg(stack); - fence = f; - } - + top_index = av_tindex_nomg(stack); if (top_index - fence >= 0) { /* If the top entry on the stack is an operator, it had better * be a '!', otherwise the entry below the top operand should @@ -15976,6 +15974,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, SAVEFREEPV(name); if (FOLD) { lookup_name = savepv(Perl_form(aTHX_ "__%s_i", name)); + + /* The function call just below that uses this can fail + * to return, leaking memory if we don't do this */ + SAVEFREEPV(lookup_name); } /* Look up the property name, and get its swash and @@ -15991,9 +15993,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, NULL, /* No inversion list */ &swash_init_flags ); - if (lookup_name) { - Safefree(lookup_name); - } if (! swash || ! (invlist = _get_swash_invlist(swash))) { HV* curpkg = (IN_PERL_COMPILETIME) ? PL_curstash @@ -18340,7 +18339,7 @@ S_regtail(pTHX_ RExC_state_t * pRExC_state, DEBUG_PARSE_r({ DEBUG_PARSE_MSG((scan==p ? "tail" : "")); regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state); - Perl_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)] : "") @@ -18430,7 +18429,7 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, DEBUG_PARSE_r({ DEBUG_PARSE_MSG((scan==p ? "tsdy" : "")); regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state); - Perl_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]); @@ -18442,7 +18441,7 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, DEBUG_PARSE_r({ DEBUG_PARSE_MSG(""); regprop(RExC_rx, RExC_mysv, val, NULL, pRExC_state); - Perl_re_printf( + Perl_re_printf( aTHX_ "~ attach to %s (%"IVdf") offset to %"IVdf"\n", SvPV_nolen_const(RExC_mysv), (IV)REG_NODE_NUM(val), @@ -18476,15 +18475,15 @@ S_regdump_intflags(pTHX_ const char *lead, const U32 flags) for (bit=0; bitanchored_substr) { RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr), RE_SV_DUMPLEN(r->anchored_substr), 30); - Perl_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); - Perl_re_printf( + Perl_re_printf( aTHX_ "anchored utf8 %s%s at %"IVdf" ", s, RE_SV_TAIL(r->anchored_utf8), (IV)r->anchored_offset); @@ -18570,55 +18569,55 @@ Perl_regdump(pTHX_ const regexp *r) if (r->float_substr) { RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr), RE_SV_DUMPLEN(r->float_substr), 30); - Perl_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); - Perl_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) - Perl_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) - Perl_re_printf( " noscan"); + Perl_re_printf( aTHX_ " noscan"); if (r->extflags & RXf_CHECK_ALL) - Perl_re_printf( " isall"); + Perl_re_printf( aTHX_ " isall"); if (r->check_substr || r->check_utf8) - Perl_re_printf( ") "); + Perl_re_printf( aTHX_ ") "); if (ri->regstclass) { regprop(r, sv, ri->regstclass, NULL, NULL); - Perl_re_printf( "stclass %s ", SvPVX_const(sv)); + Perl_re_printf( aTHX_ "stclass %s ", SvPVX_const(sv)); } if (r->intflags & PREGf_ANCH) { - Perl_re_printf( "anchored"); + Perl_re_printf( aTHX_ "anchored"); if (r->intflags & PREGf_ANCH_MBOL) - Perl_re_printf( "(MBOL)"); + Perl_re_printf( aTHX_ "(MBOL)"); if (r->intflags & PREGf_ANCH_SBOL) - Perl_re_printf( "(SBOL)"); + Perl_re_printf( aTHX_ "(SBOL)"); if (r->intflags & PREGf_ANCH_GPOS) - Perl_re_printf( "(GPOS)"); - Perl_re_printf(" "); + Perl_re_printf( aTHX_ "(GPOS)"); + Perl_re_printf( aTHX_ " "); } if (r->intflags & PREGf_GPOS_SEEN) - Perl_re_printf( "GPOS:%"UVuf" ", (UV)r->gofs); + Perl_re_printf( aTHX_ "GPOS:%"UVuf" ", (UV)r->gofs); if (r->intflags & PREGf_SKIP) - Perl_re_printf( "plus "); + Perl_re_printf( aTHX_ "plus "); if (r->intflags & PREGf_IMPLICIT) - Perl_re_printf( "implicit "); - Perl_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) - Perl_re_printf( "with eval "); - Perl_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); @@ -19025,7 +19024,7 @@ Perl_re_intuit_string(pTHX_ REGEXP * const r) ? prog->check_utf8 : prog->check_substr); if (!PL_colorset) reginitcolors(); - Perl_re_printf( + Perl_re_printf( aTHX_ "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n", PL_colors[4], RX_UTF8(r) ? "utf8 " : "", @@ -19206,7 +19205,7 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) SV *dsv= sv_newmortal(); RE_PV_QUOTED_DECL(s, RX_UTF8(rx), dsv, RX_PRECOMP(rx), RX_PRELEN(rx), 60); - Perl_re_printf("%sFreeing REx:%s %s\n", + Perl_re_printf( aTHX_ "%sFreeing REx:%s %s\n", PL_colors[4],PL_colors[5],s); } }); @@ -20201,11 +20200,11 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv, return SvCUR(sv) > orig_sv_cur; } -#define CLEAR_OPTSTART \ +#define CLEAR_OPTSTART \ if (optstart) STMT_START { \ - DEBUG_OPTIMISE_r(Perl_re_printf( \ + DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ \ " (%"IVdf" nodes)\n", (IV)(node - optstart))); \ - optstart=NULL; \ + optstart=NULL; \ } STMT_END #define DUMPUNTIL(b,e) \ @@ -20227,7 +20226,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, PERL_ARGS_ASSERT_DUMPUNTIL; #ifdef DEBUG_DUMPUNTIL - Perl_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 @@ -20253,18 +20252,18 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, CLEAR_OPTSTART; regprop(r, sv, node, NULL, NULL); - Perl_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. */ - Perl_re_printf( " (0)"); + Perl_re_printf( aTHX_ " (0)"); else if (PL_regkind[(U8)op] == BRANCH && PL_regkind[OP(next)] != BRANCH ) - Perl_re_printf( " (FAIL)"); + Perl_re_printf( aTHX_ " (FAIL)"); else - Perl_re_printf( " (%"IVdf")", (IV)(next - start)); - Perl_re_printf("\n"); + Perl_re_printf( aTHX_ " (%"IVdf")", (IV)(next - start)); + Perl_re_printf( aTHX_ "\n"); } after_print: @@ -20302,7 +20301,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { SV ** const elem_ptr = av_fetch(trie_words,word_idx,0); - Perl_re_indentf( "%s ", + Perl_re_indentf( aTHX_ "%s ", indent+3, elem_ptr ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr), @@ -20318,7 +20317,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, ); if (trie->jump) { U16 dist= trie->jump[word_idx+1]; - Perl_re_printf( "(%"UVuf")\n", + Perl_re_printf( aTHX_ "(%"UVuf")\n", (UV)((dist ? this_trie + dist : next) - start)); if (dist) { if (!nextbranch) @@ -20328,7 +20327,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH) nextbranch= regnext((regnode *)nextbranch); } else { - Perl_re_printf( "\n"); + Perl_re_printf( aTHX_ "\n"); } } if (last && next > last) @@ -20368,7 +20367,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, } CLEAR_OPTSTART; #ifdef DEBUG_DUMPUNTIL - Perl_re_printf( "--- %d\n", (int)indent); + Perl_re_printf( aTHX_ "--- %d\n", (int)indent); #endif return node; }