X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2eccd3b2550197fc30b4f217fbedb861d6732099..cde0cee5716418bb58782f073048ee9685ed2368:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 7297eb6..d07f177 100644 --- a/regcomp.c +++ b/regcomp.c @@ -57,7 +57,7 @@ **** Alterations to Henry's code are... **** **** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others **** **** You may distribute under the terms of either the GNU General Public **** License or the Artistic License, as specified in the README file. @@ -126,6 +126,7 @@ typedef struct RExC_state_t { I32 utf8; HV *charnames; /* cache of named sequences */ HV *paren_names; /* Paren names */ + regnode **recurse; /* Recurse regops */ I32 recurse_count; /* Number of recurse regops */ #if ADD_TO_REGEXEC @@ -135,8 +136,10 @@ typedef struct RExC_state_t { #ifdef DEBUGGING const char *lastparse; I32 lastnum; + AV *paren_name_list; /* idx -> name */ #define RExC_lastparse (pRExC_state->lastparse) #define RExC_lastnum (pRExC_state->lastnum) +#define RExC_paren_name_list (pRExC_state->paren_name_list) #endif } RExC_state_t; @@ -156,7 +159,6 @@ typedef struct RExC_state_t { #define RExC_seen (pRExC_state->seen) #define RExC_size (pRExC_state->size) #define RExC_npar (pRExC_state->npar) -#define RExC_cpar (pRExC_state->cpar) #define RExC_nestroot (pRExC_state->nestroot) #define RExC_extralen (pRExC_state->extralen) #define RExC_seen_zerolen (pRExC_state->seen_zerolen) @@ -170,6 +172,7 @@ typedef struct RExC_state_t { #define RExC_recurse (pRExC_state->recurse) #define RExC_recurse_count (pRExC_state->recurse_count) + #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?') #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \ ((*s) == '{' && regcurly(s))) @@ -557,17 +560,18 @@ static const scan_data_t zero_scan_data = #define EXPERIMENTAL_INPLACESCAN #endif -#define DEBUG_STUDYDATA(data,depth) \ -DEBUG_OPTIMISE_MORE_r(if(data){ \ +#define DEBUG_STUDYDATA(str,data,depth) \ +DEBUG_OPTIMISE_MORE_r(if(data){ \ PerlIO_printf(Perl_debug_log, \ - "%*s"/* Len:%"IVdf"/%"IVdf" */"Pos:%"IVdf"/%"IVdf \ - " Flags: %"IVdf" Whilem_c: %"IVdf" Lcp: %"IVdf" ", \ + "%*s" str "Pos:%"IVdf"/%"IVdf \ + " Flags: 0x%"UVXf" Whilem_c: %"IVdf" Lcp: %"IVdf" %s", \ (int)(depth)*2, "", \ (IV)((data)->pos_min), \ (IV)((data)->pos_delta), \ - (IV)((data)->flags), \ + (UV)((data)->flags), \ (IV)((data)->whilem_c), \ - (IV)((data)->last_closep ? *((data)->last_closep) : -1) \ + (IV)((data)->last_closep ? *((data)->last_closep) : -1), \ + is_inf ? "INF " : "" \ ); \ if ((data)->last_found) \ PerlIO_printf(Perl_debug_log, \ @@ -597,7 +601,7 @@ static void clear_re(pTHX_ void *r); floating substrings if needed. */ STATIC void -S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp) +S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *minlenp, int is_inf) { const STRLEN l = CHR_SVLEN(data->last_found); const STRLEN old_l = CHR_SVLEN(*data->longest); @@ -615,12 +619,12 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *min data->minlen_fixed=minlenp; data->lookbehind_fixed=0; } - else { + else { /* *data->longest == data->longest_float */ data->offset_float_min = l ? data->last_start_min : data->pos_min; data->offset_float_max = (l ? data->last_start_max : data->pos_min + data->pos_delta); - if ((U32)data->offset_float_max > (U32)I32_MAX) + if (is_inf || (U32)data->offset_float_max > (U32)I32_MAX) data->offset_float_max = I32_MAX; if (data->flags & SF_BEFORE_EOL) data->flags @@ -642,7 +646,7 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *min } data->last_end = -1; data->flags &= ~SF_BEFORE_EOL; - DEBUG_STUDYDATA(data,0); + DEBUG_STUDYDATA("cl_anything: ",data,0); } /* Can match anything (initialization) */ @@ -798,9 +802,9 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con #ifdef DEBUGGING /* - dump_trie(trie) - dump_trie_interim_list(trie,next_alloc) - dump_trie_interim_table(trie,next_alloc) + dump_trie(trie,widecharmap,revcharmap) + dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc) + dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc) These routines dump out a trie in a somewhat readable format. The _interim_ variants are used for debugging the interim @@ -813,17 +817,17 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con */ /* - dump_trie(trie) Dumps the final compressed table form of the trie to Perl_debug_log. Used for debugging make_trie(). */ STATIC void -S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth) +S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, + AV *revcharmap, U32 depth) { U32 state; SV *sv=sv_newmortal(); - int colwidth= trie->widecharmap ? 6 : 4; + int colwidth= widecharmap ? 6 : 4; GET_RE_DEBUG_FLAGS_DECL; @@ -832,7 +836,7 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth) "Match","Base","Ofs" ); for( state = 0 ; state < trie->uniquecharcount ; state++ ) { - SV ** const tmp = av_fetch( trie->revcharmap, state, 0); + SV ** const tmp = av_fetch( revcharmap, state, 0); if ( tmp ) { PerlIO_printf( Perl_debug_log, "%*s", colwidth, @@ -894,18 +898,19 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth) } } /* - dump_trie_interim_list(trie,next_alloc) Dumps a fully constructed but uncompressed trie in list form. List tries normally only are used for construction when the number of possible chars (trie->uniquecharcount) is very high. Used for debugging make_trie(). */ STATIC void -S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc,U32 depth) +S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, + HV *widecharmap, AV *revcharmap, U32 next_alloc, + U32 depth) { U32 state; SV *sv=sv_newmortal(); - int colwidth= trie->widecharmap ? 6 : 4; + int colwidth= widecharmap ? 6 : 4; GET_RE_DEBUG_FLAGS_DECL; /* print out the table precompression. */ PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s", @@ -925,7 +930,7 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc ); } for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) { - SV ** const tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0); + SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0); if ( tmp ) { PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ", colwidth, @@ -947,19 +952,20 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc } /* - dump_trie_interim_table(trie,next_alloc) Dumps a fully constructed but uncompressed trie in table form. This is the normal DFA style state transition table, with a few twists to facilitate compression later. Used for debugging make_trie(). */ STATIC void -S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc, U32 depth) +S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, + HV *widecharmap, AV *revcharmap, U32 next_alloc, + U32 depth) { U32 state; U16 charid; SV *sv=sv_newmortal(); - int colwidth= trie->widecharmap ? 6 : 4; + int colwidth= widecharmap ? 6 : 4; GET_RE_DEBUG_FLAGS_DECL; /* @@ -970,7 +976,7 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_allo PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" ); for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { - SV ** const tmp = av_fetch( trie->revcharmap, charid, 0); + SV ** const tmp = av_fetch( revcharmap, charid, 0); if ( tmp ) { PerlIO_printf( Perl_debug_log, "%*s", colwidth, @@ -1137,7 +1143,7 @@ is the recommended Unicode-aware way of saying SV *tmp = newSVpvs(""); \ if (UTF) SvUTF8_on(tmp); \ Perl_sv_catpvf( aTHX_ tmp, "%c", (int)uvc ); \ - av_push( TRIE_REVCHARMAP(trie), tmp ); \ + av_push( revcharmap, tmp ); \ } STMT_END #define TRIE_READ_CHAR STMT_START { \ @@ -1197,14 +1203,14 @@ is the recommended Unicode-aware way of saying else \ tmp = newSVpvn( "", 0 ); \ if ( UTF ) SvUTF8_on( tmp ); \ - av_push( trie->words, tmp ); \ + av_push( trie_words, tmp ); \ }); \ \ curword++; \ \ if ( noper_next < tail ) { \ if (!trie->jump) \ - Newxz( trie->jump, word_count + 1, U16); \ + trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \ trie->jump[curword] = (U16)(noper_next - convert); \ if (!jumper) \ jumper = noper_next; \ @@ -1218,7 +1224,8 @@ is the recommended Unicode-aware way of saying /* we only allocate the nextword buffer when there */\ /* a dupe, so first time we have to do the allocation */\ if (!trie->nextword) \ - Newxz( trie->nextword, word_count + 1, U16); \ + trie->nextword = (U16 *) \ + PerlMemShared_calloc( word_count + 1, sizeof(U16)); \ while ( trie->nextword[dupe] ) \ dupe= trie->nextword[dupe]; \ trie->nextword[dupe]= curword; \ @@ -1248,6 +1255,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs dVAR; /* first pass, loop through and scan words */ reg_trie_data *trie; + HV *widecharmap = NULL; + AV *revcharmap = newAV(); regnode *cur; const U32 uniflags = UTF8_ALLOW_DEFAULT; STRLEN len = 0; @@ -1266,32 +1275,33 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs ) ); - const U32 data_slot = add_data( pRExC_state, 1, "t" ); - SV *re_trie_maxbuff; -#ifndef DEBUGGING - /* these are only used during construction but are useful during - * debugging so we store them in the struct when debugging. +#ifdef DEBUGGING + const U32 data_slot = add_data( pRExC_state, 4, "tuuu" ); + AV *trie_words = NULL; + /* along with revcharmap, this only used during construction but both are + * useful during debugging so we store them in the struct when debugging. */ +#else + const U32 data_slot = add_data( pRExC_state, 2, "tu" ); STRLEN trie_charcount=0; - AV *trie_revcharmap; #endif + SV *re_trie_maxbuff; GET_RE_DEBUG_FLAGS_DECL; #ifndef DEBUGGING PERL_UNUSED_ARG(depth); #endif - Newxz( trie, 1, reg_trie_data ); + trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) ); trie->refcount = 1; trie->startstate = 1; trie->wordcount = word_count; RExC_rxi->data->data[ data_slot ] = (void*)trie; - Newxz( trie->charmap, 256, U16 ); + trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) ); if (!(UTF && folder)) - Newxz( trie->bitmap, ANYOF_BITMAP_SIZE, char ); + trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 ); DEBUG_r({ - trie->words = newAV(); + trie_words = newAV(); }); - TRIE_REVCHARMAP(trie) = newAV(); re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1); if (!SvIOK(re_trie_maxbuff)) { @@ -1369,10 +1379,10 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs } } else { SV** svpp; - if ( !trie->widecharmap ) - trie->widecharmap = newHV(); + if ( !widecharmap ) + widecharmap = newHV(); - svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 ); + svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 ); if ( !svpp ) Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc ); @@ -1396,11 +1406,11 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs DEBUG_TRIE_COMPILE_r( PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n", (int)depth * 2 + 2,"", - ( trie->widecharmap ? "UTF8" : "NATIVE" ), (int)word_count, + ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count, (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, (int)trie->minlen, (int)trie->maxlen ) ); - Newxz( trie->wordlen, word_count, U32 ); + trie->wordlen = (U32 *) PerlMemShared_calloc( word_count, sizeof(U32) ); /* We now know what we are dealing with in terms of unique chars and @@ -1442,8 +1452,10 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, "%*sCompiling trie using list compiler\n", (int)depth * 2 + 2, "")); - - Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state ); + + trie->states = (reg_trie_state *) + PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, + sizeof(reg_trie_state) ); TRIE_LIST_NEW(1); next_alloc = 2; @@ -1467,7 +1479,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs if ( uvc < 256 ) { charid = trie->charmap[ uvc ]; } else { - SV** const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0); + SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0); if ( !svpp ) { charid = 0; } else { @@ -1507,14 +1519,19 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs /* next alloc is the NEXT state to be allocated */ trie->statecount = next_alloc; - Renew( trie->states, next_alloc, reg_trie_state ); + trie->states = (reg_trie_state *) + PerlMemShared_realloc( trie->states, + next_alloc + * sizeof(reg_trie_state) ); /* and now dump it out before we compress it */ - DEBUG_TRIE_COMPILE_MORE_r( - dump_trie_interim_list(trie,next_alloc,depth+1) + DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap, + revcharmap, next_alloc, + depth+1) ); - Newxz( trie->trans, transcount ,reg_trie_trans ); + trie->trans = (reg_trie_trans *) + PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) ); { U32 state; U32 tp = 0; @@ -1545,7 +1562,10 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs } if ( transcount < tp + maxid - minid + 1) { transcount *= 2; - Renew( trie->trans, transcount, reg_trie_trans ); + trie->trans = (reg_trie_trans *) + PerlMemShared_realloc( trie->trans, + transcount + * sizeof(reg_trie_trans) ); Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans ); } base = trie->uniquecharcount + tp - minid; @@ -1625,9 +1645,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs "%*sCompiling trie using table compiler\n", (int)depth * 2 + 2, "")); - Newxz( trie->trans, ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1, - reg_trie_trans ); - Newxz( trie->states, TRIE_CHARCOUNT(trie) + 2, reg_trie_state ); + trie->trans = (reg_trie_trans *) + PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 ) + * trie->uniquecharcount + 1, + sizeof(reg_trie_trans) ); + trie->states = (reg_trie_state *) + PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, + sizeof(reg_trie_state) ); next_alloc = trie->uniquecharcount + 1; @@ -1655,7 +1679,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs if ( uvc < 256 ) { charid = trie->charmap[ uvc ]; } else { - SV* const * const svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 0); + SV* const * const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0); charid = svpp ? (U16)SvIV(*svpp) : 0; } if ( charid ) { @@ -1678,9 +1702,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs } /* end second pass */ /* and now dump it out before we compress it */ - DEBUG_TRIE_COMPILE_MORE_r( - dump_trie_interim_table(trie,next_alloc,depth+1) - ); + DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap, + revcharmap, + next_alloc, depth+1)); { /* @@ -1784,7 +1808,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs } } trie->lasttrans = pos + 1; - Renew( trie->states, laststate, reg_trie_state); + trie->states = (reg_trie_state *) + PerlMemShared_realloc( trie->states, laststate + * sizeof(reg_trie_state) ); DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log, "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n", @@ -1804,12 +1830,12 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs (UV)trie->lasttrans) ); /* resize the trans array to remove unused space */ - Renew( trie->trans, trie->lasttrans, reg_trie_trans); + trie->trans = (reg_trie_trans *) + PerlMemShared_realloc( trie->trans, trie->lasttrans + * sizeof(reg_trie_trans) ); /* and now dump out the compressed format */ - DEBUG_TRIE_COMPILE_r( - dump_trie(trie,depth+1) - ); + DEBUG_TRIE_COMPILE_r(dump_trie(trie, widecharmap, revcharmap, depth+1)); { /* Modify the program and insert the new TRIE node*/ U8 nodetype =(U8)(flags & 0xFF); @@ -1854,7 +1880,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs /* But first we check to see if there is a common prefix we can split out as an EXACT and put in front of the TRIE node. */ trie->startstate= 1; - if ( trie->bitmap && !trie->widecharmap && !trie->jump ) { + if ( trie->bitmap && !widecharmap && !trie->jump ) { U32 state; for ( state = 1 ; state < trie->statecount-1 ; state++ ) { U32 ofs = 0; @@ -1871,7 +1897,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs trie->trans[ base + ofs - trie->uniquecharcount ].check == state ) { if ( ++count > 1 ) { - SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), ofs, 0); + SV **tmp = av_fetch( revcharmap, ofs, 0); const U8 *ch = (U8*)SvPV_nolen_const( *tmp ); if ( state == 1 ) break; if ( count == 2 ) { @@ -1882,7 +1908,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs (int)depth * 2 + 2, "", (UV)state)); if (idx >= 0) { - SV ** const tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0); + SV ** const tmp = av_fetch( revcharmap, idx, 0); const U8 * const ch = (U8*)SvPV_nolen_const( *tmp ); TRIE_BITMAP_SET(trie,*ch); @@ -1902,7 +1928,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs } } if ( count == 1 ) { - SV **tmp = av_fetch( TRIE_REVCHARMAP(trie), idx, 0); + SV **tmp = av_fetch( revcharmap, idx, 0); char *ch = SvPV_nolen( *tmp ); DEBUG_OPTIMISE_r({ SV *sv=sv_newmortal(); @@ -1950,7 +1976,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs Set_Node_Offset_Length(fix, 0, 0); } while (word--) { - SV ** const tmp = av_fetch( trie->words, word, 0 ); + SV ** const tmp = av_fetch( trie_words, word, 0 ); if (tmp) { if ( STR_LEN(convert) <= SvCUR(*tmp) ) sv_chop(*tmp, SvPV_nolen(*tmp) + STR_LEN(convert)); @@ -1984,7 +2010,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs { OP( convert ) = TRIEC; Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char); - Safefree(trie->bitmap); + PerlMemShared_free(trie->bitmap); trie->bitmap= NULL; } else OP( convert ) = TRIE; @@ -2018,8 +2044,12 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs Set_Node_Offset_Length(convert,mjd_offset,mjd_nodelen); }); } /* end node insert */ -#ifndef DEBUGGING - SvREFCNT_dec(TRIE_REVCHARMAP(trie)); + RExC_rxi->data->data[ data_slot + 1 ] = (void*)widecharmap; +#ifdef DEBUGGING + RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words; + RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap; +#else + SvREFCNT_dec(revcharmap); #endif return trie->jump ? MADE_JUMP_TRIE @@ -2049,7 +2079,8 @@ S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode try 'g' and succeed, prodceding to match 'cdgu'. */ /* add a fail transition */ - reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[ARG(source)]; + const U32 trie_offset = ARG(source); + reg_trie_data *trie=(reg_trie_data *)RExC_rxi->data->data[trie_offset]; U32 *q; const U32 ucharcount = trie->uniquecharcount; const U32 numstates = trie->statecount; @@ -2068,13 +2099,13 @@ S_make_trie_failtable(pTHX_ RExC_state_t *pRExC_state, regnode *source, regnode ARG_SET( stclass, data_slot ); - Newxz( aho, 1, reg_ac_data ); + aho = (reg_ac_data *) PerlMemShared_calloc( 1, sizeof(reg_ac_data) ); RExC_rxi->data->data[ data_slot ] = (void*)aho; - aho->trie=trie; - aho->states=(reg_trie_state *)savepvn((const char*)trie->states, - numstates * sizeof(reg_trie_state)); + aho->trie=trie_offset; + aho->states=(reg_trie_state *)PerlMemShared_malloc( numstates * sizeof(reg_trie_state) ); + Copy( trie->states, aho->states, numstates, reg_trie_state ); Newxz( q, numstates, U32); - Newxz( aho->fail, numstates, U32 ); + aho->fail = (U32 *) PerlMemShared_calloc( numstates, sizeof(U32) ); aho->refcount = 1; fail = aho->fail; /* initialize fail[0..1] to be 1 so that we always have @@ -2328,6 +2359,9 @@ typedef struct scan_frame { I32 stop; /* what stopparen do we use */ } scan_frame; + +#define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf) + STATIC I32 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *minlenp, I32 *deltap, @@ -2373,7 +2407,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, fake_study_recurse: while ( scan && OP(scan) != END && scan < last ){ /* Peephole optimizer: */ - DEBUG_STUDYDATA(data,depth); + DEBUG_STUDYDATA("Peep:", data,depth); DEBUG_PEEP("Peep",scan,depth); JOIN_EXACT(scan,&min,0); @@ -2419,7 +2453,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, regnode * const startbranch=scan; if (flags & SCF_DO_SUBSTR) - scan_commit(pRExC_state, data, minlenp); /* Cannot merge strings after this. */ + SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */ if (flags & SCF_DO_STCLASS) cl_init_zero(pRExC_state, &accum); @@ -2741,7 +2775,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, Newx(newframe,1,scan_frame); } else { if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state,data,minlenp); + SCAN_COMMIT(pRExC_state,data,minlenp); data->longest = &(data->longest_float); } is_inf = is_inf_internal = 1; @@ -2843,7 +2877,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, /* Search for fixed substrings supports EXACT only. */ if (flags & SCF_DO_SUBSTR) { assert(data); - scan_commit(pRExC_state, data, minlenp); + SCAN_COMMIT(pRExC_state, data, minlenp); } if (UTF) { const U8 * const s = (U8 *)STRING(scan); @@ -2922,7 +2956,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, is_inf = is_inf_internal = 1; scan = regnext(scan); if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */ + SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot extend fixed substrings */ data->longest = &(data->longest_float); } goto optimize_curly_tail; @@ -2945,7 +2979,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, next_is_eval = (OP(scan) == EVAL); do_curly: if (flags & SCF_DO_SUBSTR) { - if (mincount == 0) scan_commit(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */ + if (mincount == 0) SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot extend fixed substrings */ pos_before = data->pos_min; } if (data) { @@ -3216,7 +3250,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, if (mincount != maxcount) { /* Cannot extend fixed substrings found inside the group. */ - scan_commit(pRExC_state,data,minlenp); + SCAN_COMMIT(pRExC_state,data,minlenp); if (mincount && last_str) { SV * const sv = data->last_found; MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? @@ -3248,7 +3282,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, continue; default: /* REF and CLUMP only? */ if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state,data,minlenp); /* Cannot expect anything... */ + SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */ data->longest = &(data->longest_float); } is_inf = is_inf_internal = 1; @@ -3262,7 +3296,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, int value = 0; if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state,data,minlenp); + SCAN_COMMIT(pRExC_state,data,minlenp); data->pos_min++; } min++; @@ -3551,7 +3585,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, if ((flags & SCF_DO_SUBSTR) && data->last_found) { f |= SCF_DO_SUBSTR; if (scan->flags) - scan_commit(pRExC_state, &data_fake,minlenp); + SCAN_COMMIT(pRExC_state, &data_fake,minlenp); data_fake.last_found=newSVsv(data->last_found); } } @@ -3602,7 +3636,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, if ((flags & SCF_DO_SUBSTR) && data_fake.last_found) { if (RExC_rx->minlen<*minnextp) RExC_rx->minlen=*minnextp; - scan_commit(pRExC_state, &data_fake, minnextp); + SCAN_COMMIT(pRExC_state, &data_fake, minnextp); SvREFCNT_dec(data_fake.last_found); if ( data_fake.minlen_fixed != minlenp ) @@ -3648,7 +3682,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } else if ( PL_regkind[OP(scan)] == ENDLIKE ) { if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state,data,minlenp); + SCAN_COMMIT(pRExC_state,data,minlenp); flags &= ~SCF_DO_SUBSTR; } if (data && OP(scan)==ACCEPT) { @@ -3660,7 +3694,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */ { if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state,data,minlenp); + SCAN_COMMIT(pRExC_state,data,minlenp); data->longest = &(data->longest_float); } is_inf = is_inf_internal = 1; @@ -3694,7 +3728,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, struct regnode_charclass_class accum; if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */ - scan_commit(pRExC_state, data,minlenp); /* Cannot merge strings after this. */ + SCAN_COMMIT(pRExC_state, data,minlenp); /* Cannot merge strings after this. */ if (flags & SCF_DO_STCLASS) cl_init_zero(pRExC_state, &accum); @@ -3811,7 +3845,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, delta += (trie->maxlen - trie->minlen); flags &= ~SCF_DO_STCLASS; /* xxx */ if (flags & SCF_DO_SUBSTR) { - scan_commit(pRExC_state,data,minlenp); /* Cannot expect anything... */ + SCAN_COMMIT(pRExC_state,data,minlenp); /* Cannot expect anything... */ data->pos_min += trie->minlen; data->pos_delta += (trie->maxlen - trie->minlen); if (trie->maxlen != trie->minlen) @@ -3835,6 +3869,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, finish: assert(!frame); + DEBUG_STUDYDATA("pre-fin:",data,depth); *scanp = scan; *deltap = is_inf_internal ? I32_MAX : delta; @@ -3855,7 +3890,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, if (flags & SCF_TRIE_RESTUDY) data->flags |= SCF_TRIE_RESTUDY; - DEBUG_STUDYDATA(data,depth); + DEBUG_STUDYDATA("post-fin:",data,depth); return min < stopmin ? min : stopmin; } @@ -3863,24 +3898,21 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, STATIC U32 S_add_data(RExC_state_t *pRExC_state, U32 n, const char *s) { - if (RExC_rxi->data) { - const U32 count = RExC_rxi->data->count; - Renewc(RExC_rxi->data, - sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1), - char, struct reg_data); + U32 count = RExC_rxi->data ? RExC_rxi->data->count : 0; + + Renewc(RExC_rxi->data, + sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1), + char, struct reg_data); + if(count) Renew(RExC_rxi->data->what, count + n, U8); - RExC_rxi->data->count += n; - } - else { - Newxc(RExC_rxi->data, sizeof(*RExC_rxi->data) + sizeof(void*) * (n - 1), - char, struct reg_data); + else Newx(RExC_rxi->data->what, n, U8); - RExC_rxi->data->count = n; - } - Copy(s, RExC_rxi->data->what + RExC_rxi->data->count - n, n, U8); - return RExC_rxi->data->count - n; + RExC_rxi->data->count = count + n; + Copy(s, RExC_rxi->data->what + count, n, U8); + return count; } +/*XXX: todo make this not included in a non debugging perl */ #ifndef PERL_IN_XSUB_RE void Perl_reginitcolors(pTHX) @@ -3944,23 +3976,18 @@ Perl_reginitcolors(pTHX) extern const struct regexp_engine my_reg_engine; #define RE_ENGINE_PTR &my_reg_engine #endif -/* these make a few things look better, to avoid indentation */ -#define BEGIN_BLOCK { -#define END_BLOCK } - + +#ifndef PERL_IN_XSUB_RE regexp * Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) { dVAR; - GET_RE_DEBUG_FLAGS_DECL; - DEBUG_r(if (!PL_colorset) reginitcolors()); -#ifndef PERL_IN_XSUB_RE - BEGIN_BLOCK + HV * const table = GvHV(PL_hintgv); /* Dispatch a request to compile a regexp to correct regexp engine. */ - HV * const table = GvHV(PL_hintgv); if (table) { SV **ptr= hv_fetchs(table, "regcomp", FALSE); + GET_RE_DEBUG_FLAGS_DECL; if (ptr && SvIOK(*ptr) && SvIV(*ptr)) { const regexp_engine *eng=INT2PTR(regexp_engine*,SvIV(*ptr)); DEBUG_COMPILE_r({ @@ -3970,9 +3997,14 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) return CALLREGCOMP_ENG(eng, exp, xend, pm); } } - END_BLOCK + return Perl_re_compile(aTHX_ exp, xend, pm); +} #endif - BEGIN_BLOCK + +regexp * +Perl_re_compile(pTHX_ char *exp, char *xend, PMOP *pm) +{ + dVAR; register regexp *r; register regexp_internal *ri; regnode *scan; @@ -3988,6 +4020,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) int restudied= 0; RExC_state_t copyRExC_state; #endif + GET_RE_DEBUG_FLAGS_DECL; + DEBUG_r(if (!PL_colorset) reginitcolors()); + if (exp == NULL) FAIL("NULL regexp argument"); @@ -4015,7 +4050,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) RExC_end = xend; RExC_naughty = 0; RExC_npar = 1; - RExC_cpar = 1; RExC_nestroot = 0; RExC_size = 0L; RExC_emit = &PL_regdummy; @@ -4025,6 +4059,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) RExC_close_parens = NULL; RExC_opend = NULL; RExC_paren_names = NULL; +#ifdef DEBUGGING + RExC_paren_name_list = NULL; +#endif RExC_recurse = NULL; RExC_recurse_count = 0; @@ -4111,7 +4148,6 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) RExC_end = xend; RExC_naughty = 0; RExC_npar = 1; - RExC_cpar = 1; RExC_emit_start = ri->program; RExC_emit = ri->program; #ifdef DEBUGGING @@ -4120,7 +4156,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) ri->program[RExC_size].type = 255; #endif /* Store the count of eval-groups for security checks: */ - RExC_emit->next_off = (RExC_seen_evals > (I32)U16_MAX) ? U16_MAX : (U16)RExC_seen_evals; + RExC_rx->seen_evals = RExC_seen_evals; REGC((U8)REG_MAGIC, (char*) RExC_emit++); if (reg(pRExC_state, 0, &flags,1) == NULL) return(NULL); @@ -4221,13 +4257,13 @@ reStudy: regnode *trie_op; /* this can happen only on restudy */ if ( OP(first) == TRIE ) { - struct regnode_1 *trieop; - Newxz(trieop,1,struct regnode_1); + struct regnode_1 *trieop = (struct regnode_1 *) + PerlMemShared_calloc(1, sizeof(struct regnode_1)); StructCopy(first,trieop,struct regnode_1); trie_op=(regnode *)trieop; } else { - struct regnode_charclass *trieop; - Newxz(trieop,1,struct regnode_charclass); + struct regnode_charclass *trieop = (struct regnode_charclass *) + PerlMemShared_calloc(1, sizeof(struct regnode_charclass)); StructCopy(first,trieop,struct regnode_charclass); trie_op=(regnode *)trieop; } @@ -4326,9 +4362,10 @@ reStudy: if ( RExC_npar == 1 && data.longest == &(data.longest_fixed) && data.last_start_min == 0 && data.last_end > 0 && !RExC_seen_zerolen + && !(RExC_seen & REG_SEEN_VERBARG) && (!(RExC_seen & REG_SEEN_GPOS) || (r->extflags & RXf_ANCH_GPOS))) r->extflags |= RXf_CHECK_ALL; - scan_commit(pRExC_state, &data,&minlen); + scan_commit(pRExC_state, &data,&minlen,0); SvREFCNT_dec(data.last_found); /* Note that code very similar to this but for anchored string @@ -4546,7 +4583,19 @@ reStudy: r->paren_names = (HV*)SvREFCNT_inc(RExC_paren_names); else r->paren_names = NULL; - + if (r->prelen == 3 && strEQ("\\s+", r->precomp)) + r->extflags |= RXf_WHITE; + else if (r->prelen == 1 && r->precomp[0] == '^') + r->extflags |= RXf_START_ONLY; + +#ifdef DEBUGGING + if (RExC_paren_names) { + ri->name_list_idx = add_data( pRExC_state, 1, "p" ); + ri->data->data[ri->name_list_idx] = (void*)SvREFCNT_inc(RExC_paren_name_list); + } else +#endif + ri->name_list_idx = 0; + if (RExC_recurse_count) { for ( ; RExC_recurse_count ; RExC_recurse_count-- ) { const regnode *scan = RExC_recurse[RExC_recurse_count-1]; @@ -4574,20 +4623,22 @@ reStudy: PerlIO_printf(Perl_debug_log, "\n"); }); return(r); - END_BLOCK } #undef CORE_ONLY_BLOCK -#undef END_BLOCK #undef RE_ENGINE_PTR #ifndef PERL_IN_XSUB_RE SV* -Perl_reg_named_buff_sv(pTHX_ SV* namesv) +Perl_reg_named_buff_get(pTHX_ SV* namesv, const REGEXP * const from_re, U32 flags) { - I32 parno = 0; /* no match */ - if (PL_curpm) { - const REGEXP * const rx = PM_GETRE(PL_curpm); + AV *retarray = NULL; + SV *ret; + if (flags & 1) + retarray=newAV(); + + if (from_re || PL_curpm) { + const REGEXP * const rx = from_re ? from_re : PM_GETRE(PL_curpm); if (rx && rx->paren_names) { HE *he_str = hv_fetch_ent( rx->paren_names, namesv, 0, 0 ); if (he_str) { @@ -4598,22 +4649,100 @@ Perl_reg_named_buff_sv(pTHX_ SV* namesv) if ((I32)(rx->lastparen) >= nums[i] && rx->endp[nums[i]] != -1) { - parno = nums[i]; - break; + ret = reg_numbered_buff_get(nums[i],rx,NULL,0); + if (!retarray) + return ret; + } else { + ret = newSVsv(&PL_sv_undef); + } + if (retarray) { + SvREFCNT_inc(ret); + av_push(retarray, ret); } } + if (retarray) + return (SV*)retarray; } } } - if ( !parno ) { - return 0; + return NULL; +} + +SV* +Perl_reg_numbered_buff_get(pTHX_ I32 paren, const REGEXP * const rx, SV* usesv, U32 flags) +{ + char *s = NULL; + I32 i = 0; + I32 s1, t1; + SV *sv = usesv ? usesv : newSVpvs(""); + PERL_UNUSED_ARG(flags); + + if (!rx->subbeg) { + sv_setsv(sv,&PL_sv_undef); + return sv; + } + else + if (paren == -2 && rx->startp[0] != -1) { + /* $` */ + i = rx->startp[0]; + s = rx->subbeg; + } + else + if (paren == -1 && rx->endp[0] != -1) { + /* $' */ + s = rx->subbeg + rx->endp[0]; + i = rx->sublen - rx->endp[0]; + } + else + if ( 0 <= paren && paren <= (I32)rx->nparens && + (s1 = rx->startp[paren]) != -1 && + (t1 = rx->endp[paren]) != -1) + { + /* $& $1 ... */ + i = t1 - s1; + s = rx->subbeg + s1; + } else { + sv_setsv(sv,&PL_sv_undef); + return sv; + } + assert(rx->sublen >= (s - rx->subbeg) + i ); + if (i >= 0) { + const int oldtainted = PL_tainted; + TAINT_NOT; + sv_setpvn(sv, s, i); + PL_tainted = oldtainted; + if ( (rx->extflags & RXf_CANY_SEEN) + ? (RX_MATCH_UTF8(rx) + && (!i || is_utf8_string((U8*)s, i))) + : (RX_MATCH_UTF8(rx)) ) + { + SvUTF8_on(sv); + } + else + SvUTF8_off(sv); + if (PL_tainting) { + if (RX_MATCH_TAINTED(rx)) { + if (SvTYPE(sv) >= SVt_PVMG) { + MAGIC* const mg = SvMAGIC(sv); + MAGIC* mgt; + PL_tainted = 1; + SvMAGIC_set(sv, mg->mg_moremagic); + SvTAINT(sv); + if ((mgt = SvMAGIC(sv))) { + mg->mg_moremagic = mgt; + SvMAGIC_set(sv, mg); + } + } else { + PL_tainted = 1; + SvTAINT(sv); + } + } else + SvTAINTED_off(sv); + } } else { - GV *gv_paren; - SV *sv= sv_newmortal(); - Perl_sv_setpvf(aTHX_ sv, "%"IVdf,(IV)parno); - gv_paren= Perl_gv_fetchsv(aTHX_ sv, GV_ADD, SVt_PVGV); - return GvSVn(gv_paren); + sv_setsv(sv,&PL_sv_undef); } + return sv; } #endif @@ -4632,17 +4761,19 @@ Perl_reg_named_buff_sv(pTHX_ SV* namesv) STATIC SV* S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) { char *name_start = RExC_parse; - if ( UTF ) { - STRLEN numlen; - while( isIDFIRST_uni(utf8n_to_uvchr((U8*)RExC_parse, - RExC_end - RExC_parse, &numlen, UTF8_ALLOW_DEFAULT))) - { - RExC_parse += numlen; - } - } else { - while( isIDFIRST(*RExC_parse) ) - RExC_parse++; + + if (isIDFIRST_lazy_if(RExC_parse, UTF)) { + /* skip IDFIRST by using do...while */ + if (UTF) + do { + RExC_parse += UTF8SKIP(RExC_parse); + } while (isALNUM_utf8((U8*)RExC_parse)); + else + do { + RExC_parse++; + } while (isALNUM(*RExC_parse)); } + if ( flags ) { SV* sv_name = sv_2mortal(Perl_newSVpvn(aTHX_ name_start, (int)(RExC_parse - name_start))); @@ -4878,8 +5009,6 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) return ret; } else if (*RExC_parse == '?') { /* (?...) */ - U32 posflags = 0, negflags = 0; - U32 *flagsp = &posflags; bool is_logical = 0; const char * const seqstart = RExC_parse; @@ -4888,10 +5017,46 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) ret = NULL; /* For look-ahead/behind. */ switch (paren) { + case 'P': /* (?P...) variants for those used to PCRE/Python */ + paren = *RExC_parse++; + if ( paren == '<') /* (?P<...>) named capture */ + goto named_capture; + else if (paren == '>') { /* (?P>name) named recursion */ + goto named_recursion; + } + else if (paren == '=') { /* (?P=...) named backref */ + /* this pretty much dupes the code for \k in regatom(), if + you change this make sure you change that */ + char* name_start = RExC_parse; + U32 num = 0; + SV *sv_dat = reg_scan_name(pRExC_state, + SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA); + if (RExC_parse == name_start || *RExC_parse != ')') + vFAIL2("Sequence %.3s... not terminated",parse_start); + + if (!SIZE_ONLY) { + num = add_data( pRExC_state, 1, "S" ); + RExC_rxi->data->data[num]=(void*)sv_dat; + SvREFCNT_inc(sv_dat); + } + RExC_sawback = 1; + ret = reganode(pRExC_state, + (U8)(FOLD ? (LOC ? NREFFL : NREFF) : NREF), + num); + *flagp |= HASWIDTH; + + Set_Node_Offset(ret, parse_start+1); + Set_Node_Cur_Length(ret); /* MJD */ + + nextchar(pRExC_state); + return ret; + } + goto unknown; case '<': /* (?<...) */ if (*RExC_parse == '!') paren = ','; else if (*RExC_parse != '=') + named_capture: { /* (?<...>) */ char *name_start; SV *svname; @@ -4916,6 +5081,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) if (!RExC_paren_names) { RExC_paren_names= newHV(); sv_2mortal((SV*)RExC_paren_names); +#ifdef DEBUGGING + RExC_paren_name_list= newAV(); + sv_2mortal((SV*)RExC_paren_name_list); +#endif } he_str = hv_fetch_ent( RExC_paren_names, svname, 1, 0 ); if ( he_str ) @@ -4936,6 +5105,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) SvIOK_on(sv_dat); SvIVX(sv_dat)= 1; } +#ifdef DEBUGGING + if (!av_store(RExC_paren_name_list, RExC_npar, SvREFCNT_inc(svname))) + SvREFCNT_dec(svname); +#endif /*sv_dump(sv_dat);*/ } @@ -4978,9 +5151,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) /*notreached*/ { /* named and numeric backreferences */ I32 num; - char * parse_start; case '&': /* (?&NAME) */ parse_start = RExC_parse - 1; + named_recursion: { SV *sv_dat = reg_scan_name(pRExC_state, SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA); @@ -5259,13 +5432,20 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) vFAIL("Sequence (? incomplete"); break; default: - --RExC_parse; - parse_flags: /* (?i) */ - while (*RExC_parse && strchr("iogcmsx", *RExC_parse)) { + --RExC_parse; + parse_flags: /* (?i) */ + { + U32 posflags = 0, negflags = 0; + U32 *flagsp = &posflags; + + while (*RExC_parse) { + /* && strchr("iogcmsx", *RExC_parse) */ /* (?g), (?gc) and (?o) are useless here and must be globally applied -- japhy */ - - if (*RExC_parse == 'o' || *RExC_parse == 'g') { + switch (*RExC_parse) { + CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp); + case 'o': + case 'g': if (SIZE_ONLY && ckWARN(WARN_REGEXP)) { const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G; if (! (wastedflags & wflagbit) ) { @@ -5280,8 +5460,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) ); } } - } - else if (*RExC_parse == 'c') { + break; + + case 'c': if (SIZE_ONLY && ckWARN(WARN_REGEXP)) { if (! (wastedflags & WASTED_C) ) { wastedflags |= WASTED_GC; @@ -5293,33 +5474,45 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) ); } } - } - else { pmflag(flagsp, *RExC_parse); } - - ++RExC_parse; - } - if (*RExC_parse == '-') { - flagsp = &negflags; - wastedflags = 0; /* reset so (?g-c) warns twice */ + break; + case 'k': + if (flagsp == &negflags) { + if (SIZE_ONLY && ckWARN(WARN_REGEXP)) + vWARN(RExC_parse + 1,"Useless use of (?-k)"); + } else { + *flagsp |= RXf_PMf_KEEPCOPY; + } + break; + case '-': + if (flagsp == &negflags) + goto unknown; + flagsp = &negflags; + wastedflags = 0; /* reset so (?g-c) warns twice */ + break; + case ':': + paren = ':'; + /*FALLTHROUGH*/ + case ')': + RExC_flags |= posflags; + RExC_flags &= ~negflags; + nextchar(pRExC_state); + if (paren != ':') { + *flagp = TRYAGAIN; + return NULL; + } else { + ret = NULL; + goto parse_rest; + } + /*NOTREACHED*/ + default: + unknown: + RExC_parse++; + vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart); + /*NOTREACHED*/ + } ++RExC_parse; - goto parse_flags; - } - RExC_flags |= posflags; - RExC_flags &= ~negflags; - if (*RExC_parse == ':') { - RExC_parse++; - paren = ':'; - break; - } - unknown: - if (*RExC_parse != ')') { - RExC_parse++; - vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart); } - nextchar(pRExC_state); - *flagp = TRYAGAIN; - return NULL; - } + }} /* one for the default block, one for the switch */ } else { /* (...) */ capturing_parens: @@ -5344,7 +5537,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) } else /* ! paren */ ret = NULL; - + + parse_rest: /* Pick up the branches, linking them together. */ parse_start = RExC_parse; /* MJD */ br = regbranch(pRExC_state, &flags, 1,depth+1); @@ -5401,7 +5595,6 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) ender = reg_node(pRExC_state, TAIL); break; case 1: - RExC_cpar++; ender = reganode(pRExC_state, CLOSE, parno); if (!SIZE_ONLY && RExC_seen & REG_SEEN_RECURSE) { DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log, @@ -6053,15 +6246,26 @@ S_reg_recode(pTHX_ const char value, SV **encp) /* - regatom - the lowest level - * - * Optimization: gobbles an entire sequence of ordinary characters so that - * it can turn them into a single node, which is smaller to store and - * faster to run. Backslashed characters are exceptions, each becoming a - * separate node; the code is simpler that way and it's not worth fixing. - * - * [Yes, it is worth fixing, some scripts can run twice the speed.] - * [It looks like its ok, as in S_study_chunk we merge adjacent EXACT nodes] - */ + + Try to identify anything special at the start of the pattern. If there + is, then handle it as required. This may involve generating a single regop, + such as for an assertion; or it may involve recursing, such as to + handle a () structure. + + If the string doesn't start with something special then we gobble up + as much literal text as we can. + + Once we have been able to handle whatever type of thing started the + sequence, we return. + + Note: we have to be careful with escapes, as they can be both literal + and special, and in the case of \10 and friends can either, depending + on context. Specifically there are two seperate switches for handling + escape sequences, with the one for handling literal escapes requiring + a dummy entry for all of the special escapes that are actually handled + by the other. +*/ + STATIC regnode * S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) { @@ -6073,6 +6277,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) DEBUG_PARSE("atom"); *flagp = WORST; /* Tentatively. */ + tryagain: switch (*RExC_parse) { case '^': @@ -6159,99 +6364,103 @@ tryagain: vFAIL("Quantifier follows nothing"); break; case '\\': + /* Special Escapes + + This switch handles escape sequences that resolve to some kind + of special regop and not to literal text. Escape sequnces that + resolve to literal text are handled below in the switch marked + "Literal Escapes". + + Every entry in this switch *must* have a corresponding entry + in the literal escape switch. However, the opposite is not + required, as the default for this switch is to jump to the + literal text handling code. + */ switch (*++RExC_parse) { + /* Special Escapes */ case 'A': RExC_seen_zerolen++; ret = reg_node(pRExC_state, SBOL); *flagp |= SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'G': ret = reg_node(pRExC_state, GPOS); RExC_seen |= REG_SEEN_GPOS; *flagp |= SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; + case 'K': + RExC_seen_zerolen++; + ret = reg_node(pRExC_state, KEEPS); + *flagp |= SIMPLE; + goto finish_meta_pat; case 'Z': ret = reg_node(pRExC_state, SEOL); *flagp |= SIMPLE; RExC_seen_zerolen++; /* Do not optimize RE away */ - nextchar(pRExC_state); - break; + goto finish_meta_pat; case 'z': ret = reg_node(pRExC_state, EOS); *flagp |= SIMPLE; RExC_seen_zerolen++; /* Do not optimize RE away */ - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'C': ret = reg_node(pRExC_state, CANY); RExC_seen |= REG_SEEN_CANY; *flagp |= HASWIDTH|SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'X': ret = reg_node(pRExC_state, CLUMP); *flagp |= HASWIDTH; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'w': ret = reg_node(pRExC_state, (U8)(LOC ? ALNUML : ALNUM)); *flagp |= HASWIDTH|SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'W': ret = reg_node(pRExC_state, (U8)(LOC ? NALNUML : NALNUM)); *flagp |= HASWIDTH|SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'b': RExC_seen_zerolen++; RExC_seen |= REG_SEEN_LOOKBEHIND; ret = reg_node(pRExC_state, (U8)(LOC ? BOUNDL : BOUND)); *flagp |= SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'B': RExC_seen_zerolen++; RExC_seen |= REG_SEEN_LOOKBEHIND; ret = reg_node(pRExC_state, (U8)(LOC ? NBOUNDL : NBOUND)); *flagp |= SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 's': ret = reg_node(pRExC_state, (U8)(LOC ? SPACEL : SPACE)); *flagp |= HASWIDTH|SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'S': ret = reg_node(pRExC_state, (U8)(LOC ? NSPACEL : NSPACE)); *flagp |= HASWIDTH|SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'd': ret = reg_node(pRExC_state, DIGIT); *flagp |= HASWIDTH|SIMPLE; - nextchar(pRExC_state); - Set_Node_Length(ret, 2); /* MJD */ - break; + goto finish_meta_pat; case 'D': ret = reg_node(pRExC_state, NDIGIT); *flagp |= HASWIDTH|SIMPLE; + goto finish_meta_pat; + case 'v': + ret = reganode(pRExC_state, PRUNE, 0); + ret->flags = 1; + *flagp |= SIMPLE; + goto finish_meta_pat; + case 'V': + ret = reganode(pRExC_state, SKIP, 0); + ret->flags = 1; + *flagp |= SIMPLE; + finish_meta_pat: nextchar(pRExC_state); Set_Node_Length(ret, 2); /* MJD */ - break; + break; case 'p': case 'P': { @@ -6296,86 +6505,88 @@ tryagain: ret= reg_namedseq(pRExC_state, NULL); break; case 'k': /* Handle \k and \k'NAME' */ + parse_named_seq: { char ch= RExC_parse[1]; - if (ch != '<' && ch != '\'') { - if (SIZE_ONLY) - vWARN( RExC_parse + 1, - "Possible broken named back reference treated as literal k"); - parse_start--; - goto defchar; + if (ch != '<' && ch != '\'' && ch != '{') { + RExC_parse++; + vFAIL2("Sequence %.2s... not terminated",parse_start); } else { + /* this pretty much dupes the code for (?P=...) in reg(), if + you change this make sure you change that */ char* name_start = (RExC_parse += 2); U32 num = 0; SV *sv_dat = reg_scan_name(pRExC_state, SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA); - ch= (ch == '<') ? '>' : '\''; - + ch= (ch == '<') ? '>' : (ch == '{') ? '}' : '\''; if (RExC_parse == name_start || *RExC_parse != ch) - vFAIL2("Sequence \\k%c... not terminated", - (ch == '>' ? '<' : ch)); - + vFAIL2("Sequence %.3s... not terminated",parse_start); + + if (!SIZE_ONLY) { + num = add_data( pRExC_state, 1, "S" ); + RExC_rxi->data->data[num]=(void*)sv_dat; + SvREFCNT_inc(sv_dat); + } + RExC_sawback = 1; ret = reganode(pRExC_state, (U8)(FOLD ? (LOC ? NREFFL : NREFF) : NREF), num); *flagp |= HASWIDTH; - - - if (!SIZE_ONLY) { - num = add_data( pRExC_state, 1, "S" ); - ARG_SET(ret,num); - RExC_rxi->data->data[num]=(void*)sv_dat; - SvREFCNT_inc(sv_dat); - } + /* override incorrect value set in reganode MJD */ Set_Node_Offset(ret, parse_start+1); Set_Node_Cur_Length(ret); /* MJD */ nextchar(pRExC_state); - + } break; - } - case 'n': - case 'r': - case 't': - case 'f': - case 'e': - case 'a': - case 'x': - case 'c': - case '0': - goto defchar; - case 'R': + } + case 'g': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': { I32 num; - bool isrel=(*RExC_parse=='R'); - if (isrel) + bool isg = *RExC_parse == 'g'; + bool isrel = 0; + bool hasbrace = 0; + if (isg) { RExC_parse++; + if (*RExC_parse == '{') { + RExC_parse++; + hasbrace = 1; + } + if (*RExC_parse == '-') { + RExC_parse++; + isrel = 1; + } + if (hasbrace && !isDIGIT(*RExC_parse)) { + if (isrel) RExC_parse--; + RExC_parse -= 2; + goto parse_named_seq; + } } num = atoi(RExC_parse); if (isrel) { - num = RExC_cpar - num; + num = RExC_npar - num; if (num < 1) vFAIL("Reference to nonexistent or unclosed group"); } - if (num > 9 && num >= RExC_npar) + if (!isg && num > 9 && num >= RExC_npar) goto defchar; else { char * const parse_start = RExC_parse - 1; /* MJD */ while (isDIGIT(*RExC_parse)) RExC_parse++; - + if (parse_start == RExC_parse - 1) + vFAIL("Unterminated \\g... pattern"); + if (hasbrace) { + if (*RExC_parse != '}') + vFAIL("Unterminated \\g{...} pattern"); + RExC_parse++; + } if (!SIZE_ONLY) { if (num > (I32)RExC_rx->nparens) vFAIL("Reference to nonexistent group"); - /* People make this error all the time apparently. - So we cant fail on it, even though we should - - else if (num >= RExC_cpar) - vFAIL("Reference to unclosed group will always match"); - */ } RExC_sawback = 1; ret = reganode(pRExC_state, @@ -6447,27 +6658,40 @@ tryagain: case '|': goto loopdone; case '\\': + /* Literal Escapes Switch + + This switch is meant to handle escape sequences that + resolve to a literal character. + + Every escape sequence that represents something + else, like an assertion or a char class, is handled + in the switch marked 'Special Escapes' above in this + routine, but also has an entry here as anything that + isn't explicitly mentioned here will be treated as + an unescaped equivalent literal. + */ + switch (*++p) { - case 'A': - case 'C': - case 'X': - case 'G': - case 'Z': - case 'z': - case 'w': - case 'W': - case 'b': - case 'B': - case 's': - case 'S': - case 'd': - case 'D': - case 'p': - case 'P': - case 'N': - case 'R': + /* These are all the special escapes. */ + case 'A': /* Start assertion */ + case 'b': case 'B': /* Word-boundary assertion*/ + case 'C': /* Single char !DANGEROUS! */ + case 'd': case 'D': /* digit class */ + case 'g': case 'G': /* generic-backref, pos assertion */ + case 'k': case 'K': /* named backref, keep marker */ + case 'N': /* named char sequence */ + case 'p': case 'P': /* unicode property */ + case 's': case 'S': /* space class */ + case 'v': case 'V': /* (*PRUNE) and (*SKIP) */ + case 'w': case 'W': /* word class */ + case 'X': /* eXtended Unicode "combining character sequence" */ + case 'z': case 'Z': /* End of line/string assertion */ --p; goto loopdone; + + /* Anything after here is an escape that resolves to a + literal. (Except digits, which may or may not) + */ case 'n': ender = '\n'; p++; @@ -6850,11 +7074,38 @@ S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) } +#define _C_C_T_(NAME,TEST,WORD) \ +ANYOF_##NAME: \ + if (LOC) \ + ANYOF_CLASS_SET(ret, ANYOF_##NAME); \ + else { \ + for (value = 0; value < 256; value++) \ + if (TEST) \ + ANYOF_BITMAP_SET(ret, value); \ + } \ + yesno = '+'; \ + what = WORD; \ + break; \ +case ANYOF_N##NAME: \ + if (LOC) \ + ANYOF_CLASS_SET(ret, ANYOF_N##NAME); \ + else { \ + for (value = 0; value < 256; value++) \ + if (!TEST) \ + ANYOF_BITMAP_SET(ret, value); \ + } \ + yesno = '!'; \ + what = WORD; \ + break + + /* parse a class specification and produce either an ANYOF node that - matches the pattern. If the pattern matches a single char only and - that char is < 256 then we produce an EXACT node instead. + matches the pattern or if the pattern matches a single char only and + that char is < 256 and we are case insensitive then we produce an + EXACT node instead. */ + STATIC regnode * S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth) { @@ -7117,6 +7368,8 @@ parseit: range = 0; /* this was not a true range */ } + + if (!SIZE_ONLY) { const char *what = NULL; char yesno = 0; @@ -7128,72 +7381,19 @@ parseit: * A similar issue a little earlier when switching on value. * --jhi */ switch ((I32)namedclass) { - case ANYOF_ALNUM: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_ALNUM); - else { - for (value = 0; value < 256; value++) - if (isALNUM(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Word"; - break; - case ANYOF_NALNUM: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NALNUM); - else { - for (value = 0; value < 256; value++) - if (!isALNUM(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Word"; - break; - case ANYOF_ALNUMC: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_ALNUMC); - else { - for (value = 0; value < 256; value++) - if (isALNUMC(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Alnum"; - break; - case ANYOF_NALNUMC: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NALNUMC); - else { - for (value = 0; value < 256; value++) - if (!isALNUMC(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Alnum"; - break; - case ANYOF_ALPHA: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_ALPHA); - else { - for (value = 0; value < 256; value++) - if (isALPHA(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Alpha"; - break; - case ANYOF_NALPHA: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NALPHA); - else { - for (value = 0; value < 256; value++) - if (!isALPHA(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Alpha"; - break; + case _C_C_T_(ALNUM, isALNUM(value), "Word"); + case _C_C_T_(ALNUMC, isALNUMC(value), "Alnum"); + case _C_C_T_(ALPHA, isALPHA(value), "Alpha"); + case _C_C_T_(BLANK, isBLANK(value), "Blank"); + case _C_C_T_(CNTRL, isCNTRL(value), "Cntrl"); + case _C_C_T_(GRAPH, isGRAPH(value), "Graph"); + case _C_C_T_(LOWER, isLOWER(value), "Lower"); + case _C_C_T_(PRINT, isPRINT(value), "Print"); + case _C_C_T_(PSXSPC, isPSXSPC(value), "Space"); + case _C_C_T_(PUNCT, isPUNCT(value), "Punct"); + case _C_C_T_(SPACE, isSPACE(value), "SpacePerl"); + case _C_C_T_(UPPER, isUPPER(value), "Upper"); + case _C_C_T_(XDIGIT, isXDIGIT(value), "XDigit"); case ANYOF_ASCII: if (LOC) ANYOF_CLASS_SET(ret, ANYOF_ASCII); @@ -7227,54 +7427,10 @@ parseit: } yesno = '!'; what = "ASCII"; - break; - case ANYOF_BLANK: + break; + case ANYOF_DIGIT: if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_BLANK); - else { - for (value = 0; value < 256; value++) - if (isBLANK(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Blank"; - break; - case ANYOF_NBLANK: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NBLANK); - else { - for (value = 0; value < 256; value++) - if (!isBLANK(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Blank"; - break; - case ANYOF_CNTRL: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_CNTRL); - else { - for (value = 0; value < 256; value++) - if (isCNTRL(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Cntrl"; - break; - case ANYOF_NCNTRL: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NCNTRL); - else { - for (value = 0; value < 256; value++) - if (!isCNTRL(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Cntrl"; - break; - case ANYOF_DIGIT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_DIGIT); + ANYOF_CLASS_SET(ret, ANYOF_DIGIT); else { /* consecutive digits assumed */ for (value = '0'; value <= '9'; value++) @@ -7295,183 +7451,7 @@ parseit: } yesno = '!'; what = "Digit"; - break; - case ANYOF_GRAPH: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_GRAPH); - else { - for (value = 0; value < 256; value++) - if (isGRAPH(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Graph"; - break; - case ANYOF_NGRAPH: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NGRAPH); - else { - for (value = 0; value < 256; value++) - if (!isGRAPH(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Graph"; - break; - case ANYOF_LOWER: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_LOWER); - else { - for (value = 0; value < 256; value++) - if (isLOWER(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Lower"; - break; - case ANYOF_NLOWER: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NLOWER); - else { - for (value = 0; value < 256; value++) - if (!isLOWER(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Lower"; - break; - case ANYOF_PRINT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_PRINT); - else { - for (value = 0; value < 256; value++) - if (isPRINT(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Print"; - break; - case ANYOF_NPRINT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NPRINT); - else { - for (value = 0; value < 256; value++) - if (!isPRINT(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Print"; - break; - case ANYOF_PSXSPC: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_PSXSPC); - else { - for (value = 0; value < 256; value++) - if (isPSXSPC(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Space"; - break; - case ANYOF_NPSXSPC: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NPSXSPC); - else { - for (value = 0; value < 256; value++) - if (!isPSXSPC(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Space"; - break; - case ANYOF_PUNCT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_PUNCT); - else { - for (value = 0; value < 256; value++) - if (isPUNCT(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Punct"; - break; - case ANYOF_NPUNCT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NPUNCT); - else { - for (value = 0; value < 256; value++) - if (!isPUNCT(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Punct"; - break; - case ANYOF_SPACE: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_SPACE); - else { - for (value = 0; value < 256; value++) - if (isSPACE(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "SpacePerl"; - break; - case ANYOF_NSPACE: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NSPACE); - else { - for (value = 0; value < 256; value++) - if (!isSPACE(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "SpacePerl"; - break; - case ANYOF_UPPER: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_UPPER); - else { - for (value = 0; value < 256; value++) - if (isUPPER(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "Upper"; - break; - case ANYOF_NUPPER: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NUPPER); - else { - for (value = 0; value < 256; value++) - if (!isUPPER(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "Upper"; - break; - case ANYOF_XDIGIT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_XDIGIT); - else { - for (value = 0; value < 256; value++) - if (isXDIGIT(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '+'; - what = "XDigit"; - break; - case ANYOF_NXDIGIT: - if (LOC) - ANYOF_CLASS_SET(ret, ANYOF_NXDIGIT); - else { - for (value = 0; value < 256; value++) - if (!isXDIGIT(value)) - ANYOF_BITMAP_SET(ret, value); - } - yesno = '!'; - what = "XDigit"; - break; + break; case ANYOF_MAX: /* this is to handle \p and \P */ break; @@ -7710,6 +7690,8 @@ parseit: } return ret; } +#undef _C_C_T_ + STATIC char* S_nextchar(pTHX_ RExC_state_t *pRExC_state) @@ -8217,13 +8199,12 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) /* print the details of the trie in dumpuntil instead, as * progi->data isn't available here */ const char op = OP(o); - const I32 n = ARG(o); + const U32 n = ARG(o); const reg_ac_data * const ac = IS_TRIE_AC(op) ? (reg_ac_data *)progi->data->data[n] : NULL; - const reg_trie_data * const trie = !IS_TRIE_AC(op) ? - (reg_trie_data*)progi->data->data[n] : - ac->trie; + const reg_trie_data * const trie + = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; Perl_sv_catpvf(aTHX_ sv, "-%s",reg_name[o->flags]); DEBUG_TRIE_COMPILE_r( @@ -8269,14 +8250,36 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) } else if (k == WHILEM && o->flags) /* Ordinal/of */ Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4); - else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP || OP(o)==ACCEPT) + else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP || OP(o)==ACCEPT) { Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o)); /* Parenth number */ - else if (k == GOSUB) + if ( prog->paren_names ) { + if ( k != REF || OP(o) < NREF) { + AV *list= (AV *)progi->data->data[progi->name_list_idx]; + SV **name= av_fetch(list, ARG(o), 0 ); + if (name) + Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name)); + } + else { + AV *list= (AV *)progi->data->data[ progi->name_list_idx ]; + SV *sv_dat=(SV*)progi->data->data[ ARG( o ) ]; + I32 *nums=(I32*)SvPVX(sv_dat); + SV **name= av_fetch(list, nums[0], 0 ); + I32 n; + if (name) { + for ( n=0; nflags) Perl_sv_catpvf(aTHX_ sv, ":%"SVf, - (SV*)progi->data->data[ ARG( o ) ]); + SVfARG((SV*)progi->data->data[ ARG( o ) ])); } else if (k == LOGICAL) Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */ else if (k == ANYOF) { @@ -8455,36 +8458,32 @@ Perl_re_intuit_string(pTHX_ regexp *prog) } /* - pregfree - free a regexp + pregfree() + + handles refcounting and freeing the perl core regexp structure. When + it is necessary to actually free the structure the first thing it + does is call the 'free' method of the regexp_engine associated to to + the regexp, allowing the handling of the void *pprivate; member + first. (This routine is not overridable by extensions, which is why + the extensions free is called first.) - See regdupe below if you change anything here. + See regdupe and regdupe_internal if you change anything here. */ - +#ifndef PERL_IN_XSUB_RE void Perl_pregfree(pTHX_ struct regexp *r) { dVAR; - RXi_GET_DECL(r,ri); GET_RE_DEBUG_FLAGS_DECL; if (!r || (--r->refcnt > 0)) return; - DEBUG_COMPILE_r({ - if (!PL_colorset) - reginitcolors(); - { - SV *dsv= sv_newmortal(); - RE_PV_QUOTED_DECL(s, (r->extflags & RXf_UTF8), - dsv, r->precomp, r->prelen, 60); - PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n", - PL_colors[4],PL_colors[5],s); - } - }); - + + CALLREGFREE_PVT(r); /* free the private data */ + /* gcov results gave these as non-null 100% of the time, so there's no optimisation in checking them before calling Safefree */ Safefree(r->precomp); - Safefree(ri->offsets); /* 20010421 MJD */ RX_MATCH_COPY_FREE(r); #ifdef PERL_OLD_COPY_ON_WRITE if (r->saved_copy) @@ -8503,6 +8502,45 @@ Perl_pregfree(pTHX_ struct regexp *r) } if (r->paren_names) SvREFCNT_dec(r->paren_names); + + Safefree(r->startp); + Safefree(r->endp); + Safefree(r); +} +#endif + +/* regfree_internal() + + Free the private data in a regexp. This is overloadable by + extensions. Perl takes care of the regexp structure in pregfree(), + this covers the *pprivate pointer which technically perldoesnt + know about, however of course we have to handle the + regexp_internal structure when no extension is in use. + + Note this is called before freeing anything in the regexp + structure. + */ + +void +Perl_regfree_internal(pTHX_ struct regexp *r) +{ + dVAR; + RXi_GET_DECL(r,ri); + GET_RE_DEBUG_FLAGS_DECL; + + DEBUG_COMPILE_r({ + if (!PL_colorset) + reginitcolors(); + { + SV *dsv= sv_newmortal(); + RE_PV_QUOTED_DECL(s, (r->extflags & RXf_UTF8), + dsv, r->precomp, r->prelen, 60); + PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n", + PL_colors[4],PL_colors[5],s); + } + }); + + Safefree(ri->offsets); /* 20010421 MJD */ if (ri->data) { int n = ri->data->count; PAD* new_comppad = NULL; @@ -8514,6 +8552,7 @@ Perl_pregfree(pTHX_ struct regexp *r) switch (ri->data->what[n]) { case 's': case 'S': + case 'u': SvREFCNT_dec((SV*)ri->data->data[n]); break; case 'f': @@ -8550,12 +8589,11 @@ Perl_pregfree(pTHX_ struct regexp *r) refcount = --aho->refcount; OP_REFCNT_UNLOCK; if ( !refcount ) { - Safefree(aho->states); - Safefree(aho->fail); - aho->trie=NULL; /* not necessary to free this as it is - handled by the 't' case */ - Safefree(ri->data->data[n]); /* do this last!!!! */ - Safefree(ri->regstclass); + PerlMemShared_free(aho->states); + PerlMemShared_free(aho->fail); + /* do this last!!!! */ + PerlMemShared_free(ri->data->data[n]); + PerlMemShared_free(ri->regstclass); } } break; @@ -8568,26 +8606,19 @@ Perl_pregfree(pTHX_ struct regexp *r) refcount = --trie->refcount; OP_REFCNT_UNLOCK; if ( !refcount ) { - Safefree(trie->charmap); - if (trie->widecharmap) - SvREFCNT_dec((SV*)trie->widecharmap); - Safefree(trie->states); - Safefree(trie->trans); + PerlMemShared_free(trie->charmap); + PerlMemShared_free(trie->states); + PerlMemShared_free(trie->trans); if (trie->bitmap) - Safefree(trie->bitmap); + PerlMemShared_free(trie->bitmap); if (trie->wordlen) - Safefree(trie->wordlen); + PerlMemShared_free(trie->wordlen); if (trie->jump) - Safefree(trie->jump); + PerlMemShared_free(trie->jump); if (trie->nextword) - Safefree(trie->nextword); -#ifdef DEBUGGING - if (trie->words) - SvREFCNT_dec((SV*)trie->words); - if (trie->revcharmap) - SvREFCNT_dec((SV*)trie->revcharmap); -#endif - Safefree(ri->data->data[n]); /* do this last!!!! */ + PerlMemShared_free(trie->nextword); + /* do this last!!!! */ + PerlMemShared_free(ri->data->data[n]); } } break; @@ -8598,15 +8629,12 @@ Perl_pregfree(pTHX_ struct regexp *r) Safefree(ri->data->what); Safefree(ri->data); } - Safefree(r->startp); - Safefree(r->endp); if (ri->swap) { Safefree(ri->swap->startp); Safefree(ri->swap->endp); Safefree(ri->swap); } Safefree(ri); - Safefree(r); } #define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t)) @@ -8621,37 +8649,111 @@ Perl_pregfree(pTHX_ struct regexp *r) given regexp structure. It is a no-op when not under USE_ITHREADS. (Originally this *was* re_dup() for change history see sv.c) - See pregfree() above if you change anything here. + After all of the core data stored in struct regexp is duplicated + the regexp_engine.dupe method is used to copy any private data + stored in the *pprivate pointer. This allows extensions to handle + any duplication it needs to do. + + See pregfree() and regfree_internal() if you change anything here. */ #if defined(USE_ITHREADS) +#ifndef PERL_IN_XSUB_RE regexp * -Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param) +Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param) { dVAR; regexp *ret; - regexp_internal *reti; - int i, len, npar; + int i, npar; struct reg_substr_datum *s; - RXi_GET_DECL(r,ri); - + if (!r) return (REGEXP *)NULL; if ((ret = (REGEXP *)ptr_table_fetch(PL_ptr_table, r))) return ret; - len = ri->offsets[0]; + npar = r->nparens+1; - Newxz(ret, 1, regexp); - Newxc(reti, sizeof(regexp_internal) + (len+1)*sizeof(regnode), char, regexp_internal); - RXi_SET(ret,reti); - Copy(ri->program, reti->program, len+1, regnode); - Newx(ret->startp, npar, I32); Copy(r->startp, ret->startp, npar, I32); Newx(ret->endp, npar, I32); - Copy(r->startp, ret->startp, npar, I32); + Copy(r->endp, ret->endp, npar, I32); + + if (r->substrs) { + Newx(ret->substrs, 1, struct reg_substr_data); + for (s = ret->substrs->data, i = 0; i < 3; i++, s++) { + s->min_offset = r->substrs->data[i].min_offset; + s->max_offset = r->substrs->data[i].max_offset; + s->end_shift = r->substrs->data[i].end_shift; + s->substr = sv_dup_inc(r->substrs->data[i].substr, param); + s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param); + } + } else + ret->substrs = NULL; + + ret->precomp = SAVEPVN(r->precomp, r->prelen); + ret->refcnt = r->refcnt; + ret->minlen = r->minlen; + ret->minlenret = r->minlenret; + ret->prelen = r->prelen; + ret->nparens = r->nparens; + ret->lastparen = r->lastparen; + ret->lastcloseparen = r->lastcloseparen; + ret->intflags = r->intflags; + ret->extflags = r->extflags; + + ret->sublen = r->sublen; + + ret->engine = r->engine; + + ret->paren_names = hv_dup_inc(r->paren_names, param); + + if (RX_MATCH_COPIED(ret)) + ret->subbeg = SAVEPVN(r->subbeg, r->sublen); + else + ret->subbeg = NULL; +#ifdef PERL_OLD_COPY_ON_WRITE + ret->saved_copy = NULL; +#endif + + ret->pprivate = r->pprivate; + if (ret->pprivate) + RXi_SET(ret,CALLREGDUPE_PVT(ret,param)); + + ptr_table_store(PL_ptr_table, r, ret); + return ret; +} +#endif /* PERL_IN_XSUB_RE */ + +/* + regdupe_internal() + + This is the internal complement to regdupe() which is used to copy + the structure pointed to by the *pprivate pointer in the regexp. + This is the core version of the extension overridable cloning hook. + The regexp structure being duplicated will be copied by perl prior + to this and will be provided as the regexp *r argument, however + with the /old/ structures pprivate pointer value. Thus this routine + may override any copying normally done by perl. + + It returns a pointer to the new regexp_internal structure. +*/ + +void * +Perl_regdupe_internal(pTHX_ const regexp *r, CLONE_PARAMS *param) +{ + dVAR; + regexp_internal *reti; + int len, npar; + RXi_GET_DECL(r,ri); + + npar = r->nparens+1; + len = ri->offsets[0]; + + Newxc(reti, sizeof(regexp_internal) + (len+1)*sizeof(regnode), char, regexp_internal); + Copy(ri->program, reti->program, len+1, regnode); + if(ri->swap) { Newx(reti->swap, 1, regexp_paren_ofs); /* no need to copy these */ @@ -8661,14 +8763,6 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param) reti->swap = NULL; } - Newx(ret->substrs, 1, struct reg_substr_data); - for (s = ret->substrs->data, i = 0; i < 3; i++, s++) { - s->min_offset = r->substrs->data[i].min_offset; - s->max_offset = r->substrs->data[i].max_offset; - s->end_shift = r->substrs->data[i].end_shift; - s->substr = sv_dup_inc(r->substrs->data[i].substr, param); - s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param); - } reti->regstclass = NULL; if (ri->data) { @@ -8684,15 +8778,14 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param) for (i = 0; i < count; i++) { d->what[i] = ri->data->what[i]; switch (d->what[i]) { - /* legal options are one of: sSfpontT + /* legal options are one of: sSfpontTu see also regcomp.h and pregfree() */ case 's': case 'S': + case 'p': /* actually an AV, but the dup function is identical. */ + case 'u': /* actually an HV, but the dup function is identical. */ d->data[i] = sv_dup_inc((SV *)ri->data->data[i], param); break; - case 'p': - d->data[i] = av_dup_inc((AV *)ri->data->data[i], param); - break; case 'f': /* This is cheating. */ Newx(d->data[i], 1, struct regnode_charclass_class); @@ -8707,25 +8800,20 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param) d->data[i] = (void*)OpREFCNT_inc((OP*)ri->data->data[i]); OP_REFCNT_UNLOCK; break; - case 'n': - d->data[i] = ri->data->data[i]; - break; - case 't': - d->data[i] = ri->data->data[i]; - OP_REFCNT_LOCK; - ((reg_trie_data*)d->data[i])->refcount++; - OP_REFCNT_UNLOCK; - break; case 'T': - d->data[i] = ri->data->data[i]; - OP_REFCNT_LOCK; - ((reg_ac_data*)d->data[i])->refcount++; - OP_REFCNT_UNLOCK; /* Trie stclasses are readonly and can thus be shared * without duplication. We free the stclass in pregfree * when the corresponding reg_ac_data struct is freed. */ reti->regstclass= ri->regstclass; + /* Fall through */ + case 't': + OP_REFCNT_LOCK; + ((reg_trie_data*)ri->data->data[i])->refcount++; + OP_REFCNT_UNLOCK; + /* Fall through */ + case 'n': + d->data[i] = ri->data->data[i]; break; default: Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'", ri->data->what[i]); @@ -8737,38 +8825,15 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param) else reti->data = NULL; + reti->name_list_idx = ri->name_list_idx; + Newx(reti->offsets, 2*len+1, U32); Copy(ri->offsets, reti->offsets, 2*len+1, U32); - - ret->precomp = SAVEPVN(r->precomp, r->prelen); - ret->refcnt = r->refcnt; - ret->minlen = r->minlen; - ret->minlenret = r->minlenret; - ret->prelen = r->prelen; - ret->nparens = r->nparens; - ret->lastparen = r->lastparen; - ret->lastcloseparen = r->lastcloseparen; - ret->intflags = r->intflags; - ret->extflags = r->extflags; - - ret->sublen = r->sublen; - - ret->engine = r->engine; - ret->paren_names = hv_dup_inc(r->paren_names, param); - - if (RX_MATCH_COPIED(ret)) - ret->subbeg = SAVEPVN(r->subbeg, r->sublen); - else - ret->subbeg = NULL; -#ifdef PERL_OLD_COPY_ON_WRITE - ret->saved_copy = NULL; -#endif - - ptr_table_store(PL_ptr_table, r, ret); - return ret; + return (void*)reti; } -#endif + +#endif /* USE_ITHREADS */ /* reg_stringify() @@ -8781,38 +8846,40 @@ Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param) resulting string If flags is nonnull and the returned string contains UTF8 then - (flags & 1) will be true. + (*flags & 1) will be true. If haseval is nonnull then it is used to return whether the pattern contains evals. Normally called via macro: - CALLREG_STRINGIFY(mg,0,0); + CALLREG_STRINGIFY(mg,&len,&utf8); And internally with - CALLREG_AS_STR(mg,lp,flags,haseval) + CALLREG_AS_STR(mg,&lp,&flags,&haseval) See sv_2pv_flags() in sv.c for an example of internal usage. */ - +#ifndef PERL_IN_XSUB_RE char * Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval ) { dVAR; const regexp * const re = (regexp *)mg->mg_obj; - RXi_GET_DECL(re,ri); - + if (!mg->mg_ptr) { const char *fptr = "msix"; - char reflags[6]; + char reflags[7]; char ch; - int left = 0; - int right = 4; - bool need_newline = 0; - U16 reganch = (U16)((re->extflags & RXf_PMf_COMPILETIME) >> 12); - + bool hask = ((re->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY); + bool hasm = ((re->extflags & RXf_PMf_STD_PMMOD) != RXf_PMf_STD_PMMOD); + U16 reganch = (U16)((re->extflags & RXf_PMf_STD_PMMOD) >> 12); + bool need_newline = 0; + int left = 0; + int right = 4 + hask; + if (hask) + reflags[left++]='k'; while((ch = *fptr++)) { if(reganch & 1) { reflags[left++] = ch; @@ -8822,11 +8889,11 @@ Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval ) { } reganch >>= 1; } - if(left != 4) { + if(hasm) { reflags[left] = '-'; - left = 5; + left = 5 + hask; } - + /* printf("[%*.7s]\n",left,reflags); */ mg->mg_len = re->prelen + 4 + left; /* * If /x was used, we have to worry about a regex ending with a @@ -8866,7 +8933,7 @@ Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval ) { mg->mg_ptr[mg->mg_len] = 0; } if (haseval) - *haseval = ri->program[0].next_off; + *haseval = re->seen_evals; if (flags) *flags = ((re->extflags & RXf_UTF8) ? 1 : 0); @@ -8875,8 +8942,6 @@ Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval ) { return mg->mg_ptr; } - -#ifndef PERL_IN_XSUB_RE /* - regnext - dig the "next" pointer out of a node */ @@ -9022,9 +9087,10 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, register U8 op = PSEUDO; /* Arbitrary non-END op. */ register const regnode *next; const regnode *optstart= NULL; + RXi_GET_DECL(r,ri); GET_RE_DEBUG_FLAGS_DECL; - + #ifdef DEBUG_DUMPUNTIL PerlIO_printf(Perl_debug_log, "--- %d : %d - %d - %d\n",indent,node-start, last ? last-start : 0,plast ? plast-start : 0); @@ -9035,13 +9101,12 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, while (PL_regkind[op] != END && (!last || node < last)) { /* While that wasn't END last time... */ - NODE_ALIGN(node); op = OP(node); if (op == CLOSE || op == WHILEM) indent--; next = regnext((regnode *)node); - + /* Where, what. */ if (OP(node) == OPTIMIZED) { if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE)) @@ -9050,23 +9115,21 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, goto after_print; } else CLEAR_OPTSTART; - + regprop(r, sv, node); PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start), (int)(2*indent + 1), "", SvPVX_const(sv)); - - if (OP(node) != OPTIMIZED) { - if (next == NULL) /* Next ptr. */ - PerlIO_printf(Perl_debug_log, "(0)"); - else if (PL_regkind[(U8)op] == BRANCH && PL_regkind[OP(next)] != BRANCH ) - PerlIO_printf(Perl_debug_log, "(FAIL)"); - else - PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); - - /*if (PL_regkind[(U8)op] != TRIE)*/ - (void)PerlIO_putc(Perl_debug_log, '\n'); - } - + + if (OP(node) != OPTIMIZED) { + if (next == NULL) /* Next ptr. */ + PerlIO_printf(Perl_debug_log, " (0)"); + else if (PL_regkind[(U8)op] == BRANCH && PL_regkind[OP(next)] != BRANCH ) + PerlIO_printf(Perl_debug_log, " (FAIL)"); + else + PerlIO_printf(Perl_debug_log, " (%"IVdf")", (IV)(next - start)); + (void)PerlIO_putc(Perl_debug_log, '\n'); + } + after_print: if (PL_regkind[(U8)op] == BRANCHJ) { assert(next); @@ -9086,18 +9149,20 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, else if ( PL_regkind[(U8)op] == TRIE ) { const regnode *this_trie = node; const char op = OP(node); - const I32 n = ARG(node); + const U32 n = ARG(node); const reg_ac_data * const ac = op>=AHOCORASICK ? (reg_ac_data *)ri->data->data[n] : NULL; - const reg_trie_data * const trie = opdata->data[n] : - ac->trie; + const reg_trie_data * const trie = + (reg_trie_data*)ri->data->data[optrie]; +#ifdef DEBUGGING + AV *const trie_words = (AV *) ri->data->data[n + TRIE_WORDS_OFFSET]; +#endif const regnode *nextbranch= NULL; I32 word_idx; sv_setpvn(sv, "", 0); for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { - SV ** const elem_ptr = av_fetch(trie->words,word_idx,0); + SV ** const elem_ptr = av_fetch(trie_words,word_idx,0); PerlIO_printf(Perl_debug_log, "%*s%s ", (int)(2*(indent+3)), "",