#include "inline_invlist.c"
#include "unicode_constants.h"
-#define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
+#define HAS_NONLATIN1_FOLD_CLOSURE(i) \
+ _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i)
#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
#define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c)
char *precomp; /* uncompiled string. */
REGEXP *rx_sv; /* The SV that is the regexp. */
regexp *rx; /* perl core regexp structure */
- regexp_internal *rxi; /* internal data for regexp object pprivate field */
+ regexp_internal *rxi; /* internal data for regexp object
+ pprivate field */
char *start; /* Start of input for compile */
char *end; /* End of input for compile */
char *parse; /* Input-scan pointer. */
SSize_t whilem_seen; /* number of WHILEM in this expr */
regnode *emit_start; /* Start of emitted-code area */
- regnode *emit_bound; /* First regnode outside of the allocated space */
+ regnode *emit_bound; /* First regnode outside of the
+ allocated space */
regnode *emit; /* Code-emit pointer; if = &emit_dummy,
implies compiling, so don't emit */
regnode_ssc emit_dummy; /* placeholder for emit to point to;
I32 sawback; /* Did we see \1, ...? */
U32 seen;
SSize_t size; /* Code size. */
- I32 npar; /* Capture buffer count, (OPEN) plus one. ("par" 0 is the whole pattern)*/
- I32 nestroot; /* root parens we are in - used by accept */
+ I32 npar; /* Capture buffer count, (OPEN) plus
+ one. ("par" 0 is the whole
+ pattern)*/
+ I32 nestroot; /* root parens we are in - used by
+ accept */
I32 extralen;
I32 seen_zerolen;
regnode **open_parens; /* pointers to open parens */
rules, even if the pattern is not in
utf8 */
HV *paren_names; /* Paren names */
-
+
regnode **recurse; /* Recurse regops */
I32 recurse_count; /* Number of recurse regops */
- U8 *study_chunk_recursed; /* bitmap of which parens we have moved through */
+ U8 *study_chunk_recursed; /* bitmap of which parens we have moved
+ through */
U32 study_chunk_recursed_bytes; /* bytes in bitmap */
I32 in_lookbehind;
I32 contains_locale;
#define RExC_parse (pRExC_state->parse)
#define RExC_whilem_seen (pRExC_state->whilem_seen)
#ifdef RE_TRACK_PATTERN_OFFSETS
-#define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the others */
+#define RExC_offsets (pRExC_state->rxi->u.offsets) /* I am not like the
+ others */
#endif
#define RExC_emit (pRExC_state->emit)
#define RExC_emit_dummy (pRExC_state->emit_dummy)
#define RExC_recurse (pRExC_state->recurse)
#define RExC_recurse_count (pRExC_state->recurse_count)
#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed)
-#define RExC_study_chunk_recursed_bytes (pRExC_state->study_chunk_recursed_bytes)
+#define RExC_study_chunk_recursed_bytes \
+ (pRExC_state->study_chunk_recursed_bytes)
#define RExC_in_lookbehind (pRExC_state->in_lookbehind)
#define RExC_contains_locale (pRExC_state->contains_locale)
#define RExC_contains_i (pRExC_state->contains_i)
During optimisation we recurse through the regexp program performing
various inplace (keyhole style) optimisations. In addition study_chunk
and scan_commit populate this data structure with information about
- what strings MUST appear in the pattern. We look for the longest
+ what strings MUST appear in the pattern. We look for the longest
string that must appear at a fixed location, and we look for the
longest string that may appear at a floating location. So for instance
in the pattern:
-
+
/FOO[xX]A.*B[xX]BAR/
-
+
Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
strings (because they follow a .* construct). study_chunk will identify
both FOO and BAR as being the longest fixed and floating strings respectively.
-
+
The strings can be composites, for instance
-
+
/(f)(o)(o)/
-
+
will result in a composite fixed substring 'foo'.
-
+
For each string some basic information is maintained:
-
+
- offset or min_offset
This is the position the string must appear at, or not before.
It also implicitly (when combined with minlenp) tells us how many
characters must match before the string we are searching for.
Likewise when combined with minlenp and the length of the string it
- tells us how many characters must appear after the string we have
+ tells us how many characters must appear after the string we have
found.
-
+
- max_offset
Only used for floating strings. This is the rightmost point that
the string can appear at. If set to SSize_t_MAX it indicates that the
string can occur infinitely far to the right.
-
+
- minlenp
A pointer to the minimum number of characters of the pattern that the
string was found inside. This is important as in the case of positive
- lookahead or positive lookbehind we can have multiple patterns
+ lookahead or positive lookbehind we can have multiple patterns
involved. Consider
-
+
/(?=FOO).*F/
-
+
The minimum length of the pattern overall is 3, the minimum length
of the lookahead part is 3, but the minimum length of the part that
- will actually match is 1. So 'FOO's minimum length is 3, but the
+ will actually match is 1. So 'FOO's minimum length is 3, but the
minimum length for the F is 1. This is important as the minimum length
- is used to determine offsets in front of and behind the string being
+ is used to determine offsets in front of and behind the string being
looked for. Since strings can be composites this is the length of the
pattern at the time it was committed with a scan_commit. Note that
the length is calculated by study_chunk, so that the minimum lengths
- are not known until the full pattern has been compiled, thus the
+ are not known until the full pattern has been compiled, thus the
pointer to the value.
-
+
- lookbehind
-
+
In the case of lookbehind the string being searched for can be
- offset past the start point of the final matching string.
+ offset past the start point of the final matching string.
If this value was just blithely removed from the min_offset it would
invalidate some of the calculations for how many chars must match
before or after (as they are derived from min_offset and minlen and
- the length of the string being searched for).
+ the length of the string being searched for).
When the final pattern is compiled and the data is moved from the
scan_data_t structure into the regexp structure the information
- about lookbehind is factored in, with the information that would
- have been lost precalculated in the end_shift field for the
+ about lookbehind is factored in, with the information that would
+ have been lost precalculated in the end_shift field for the
associated string.
The fields pos_min and pos_delta are used to store the minimum offset
- and the delta to the maximum offset at the current point in the pattern.
+ and the delta to the maximum offset at the current point in the pattern.
*/
#define SCF_WHILEM_VISITED_POS 0x2000
#define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
-#define SCF_SEEN_ACCEPT 0x8000
+#define SCF_SEEN_ACCEPT 0x8000
#define SCF_TRIE_DOING_RESTUDY 0x10000
#define UTF cBOOL(RExC_utf8)
/* The enums for all these are ordered so things work out correctly */
#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
-#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_DEPENDS_CHARSET)
+#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) \
+ == REGEX_DEPENDS_CHARSET)
#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
-#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) >= REGEX_UNICODE_CHARSET)
-#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_RESTRICTED_CHARSET)
-#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) >= REGEX_ASCII_RESTRICTED_CHARSET)
-#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
+#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) \
+ >= REGEX_UNICODE_CHARSET)
+#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
+ == REGEX_ASCII_RESTRICTED_CHARSET)
+#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
+ >= REGEX_ASCII_RESTRICTED_CHARSET)
+#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) \
+ == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
#define MARKER1 "<-- HERE" /* marker as it appears in the description */
#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
-#define REPORT_LOCATION " in regex; marked by " MARKER1 " in m/%"UTF8f MARKER2 "%"UTF8f"/"
+#define REPORT_LOCATION " in regex; marked by " MARKER1 \
+ " in m/%"UTF8f MARKER2 "%"UTF8f"/"
#define REPORT_LOCATION_ARGS(offset) \
UTF8fARG(UTF, offset, RExC_precomp), \
if (!SIZE_ONLY) *(s) = (c); else (void)(s); \
} STMT_END
-/* Macros for recording node offsets. 20001227 mjd@plover.com
+/* Macros for recording node offsets. 20001227 mjd@plover.com
* Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
* element 2*n-1 of the array. Element #2n holds the byte length node #n.
* Element 0 holds the number n.
#define Set_Node_Length_To_R(node,len)
#define Set_Node_Length(node,len)
#define Set_Node_Cur_Length(node,start)
-#define Node_Offset(n)
-#define Node_Length(n)
+#define Node_Offset(n)
+#define Node_Length(n)
#define Set_Node_Offset_Length(node,offset,len)
#define ProgLen(ri) ri->u.proglen
#define SetProgLen(ri,x) ri->u.proglen = x
MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
__LINE__, (int)(node), (int)(byte))); \
if((node) < 0) { \
- Perl_croak(aTHX_ "value of node is %d in Offset macro", (int)(node)); \
+ Perl_croak(aTHX_ "value of node is %d in Offset macro", \
+ (int)(node)); \
} else { \
RExC_offsets[2*(node)-1] = (byte); \
} \
MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
__LINE__, (int)(node), (int)(len))); \
if((node) < 0) { \
- Perl_croak(aTHX_ "value of node is %d in Length macro", (int)(node)); \
+ Perl_croak(aTHX_ "value of node is %d in Length macro", \
+ (int)(node)); \
} else { \
RExC_offsets[2*(node)] = (len); \
} \
#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
#define DEBUG_RExC_seen() \
- DEBUG_OPTIMISE_MORE_r({ \
- PerlIO_printf(Perl_debug_log,"RExC_seen: "); \
- \
- if (RExC_seen & REG_SEEN_ZERO_LEN) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_ZERO_LEN "); \
- \
- if (RExC_seen & REG_SEEN_LOOKBEHIND) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_LOOKBEHIND "); \
- \
- if (RExC_seen & REG_SEEN_GPOS) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_GPOS "); \
- \
- if (RExC_seen & REG_SEEN_CANY) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_CANY "); \
- \
- if (RExC_seen & REG_SEEN_RECURSE) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_RECURSE "); \
- \
- if (RExC_seen & REG_TOP_LEVEL_BRANCHES) \
- PerlIO_printf(Perl_debug_log,"REG_TOP_LEVEL_BRANCHES "); \
- \
- if (RExC_seen & REG_SEEN_VERBARG) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_VERBARG "); \
- \
- if (RExC_seen & REG_SEEN_CUTGROUP) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_CUTGROUP "); \
- \
- if (RExC_seen & REG_SEEN_RUN_ON_COMMENT) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_RUN_ON_COMMENT "); \
- \
- if (RExC_seen & REG_SEEN_EXACTF_SHARP_S) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_EXACTF_SHARP_S "); \
- \
- if (RExC_seen & REG_SEEN_GOSTART) \
- PerlIO_printf(Perl_debug_log,"REG_SEEN_GOSTART "); \
- \
- PerlIO_printf(Perl_debug_log,"\n"); \
+ DEBUG_OPTIMISE_MORE_r({ \
+ PerlIO_printf(Perl_debug_log,"RExC_seen: "); \
+ \
+ if (RExC_seen & REG_SEEN_ZERO_LEN) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_ZERO_LEN "); \
+ \
+ if (RExC_seen & REG_SEEN_LOOKBEHIND) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_LOOKBEHIND "); \
+ \
+ if (RExC_seen & REG_SEEN_GPOS) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_GPOS "); \
+ \
+ if (RExC_seen & REG_SEEN_CANY) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_CANY "); \
+ \
+ if (RExC_seen & REG_SEEN_RECURSE) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_RECURSE "); \
+ \
+ if (RExC_seen & REG_TOP_LEVEL_BRANCHES) \
+ PerlIO_printf(Perl_debug_log,"REG_TOP_LEVEL_BRANCHES "); \
+ \
+ if (RExC_seen & REG_SEEN_VERBARG) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_VERBARG "); \
+ \
+ if (RExC_seen & REG_SEEN_CUTGROUP) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_CUTGROUP "); \
+ \
+ if (RExC_seen & REG_SEEN_RUN_ON_COMMENT) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_RUN_ON_COMMENT "); \
+ \
+ if (RExC_seen & REG_SEEN_EXACTF_SHARP_S) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_EXACTF_SHARP_S "); \
+ \
+ if (RExC_seen & REG_SEEN_GOSTART) \
+ PerlIO_printf(Perl_debug_log,"REG_SEEN_GOSTART "); \
+ \
+ PerlIO_printf(Perl_debug_log,"\n"); \
});
#define DEBUG_STUDYDATA(str,data,depth) \
#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
#define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
-#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list ? (TRIE_LIST_CUR( idx ) - 1) : 0 )
+#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list \
+ ? (TRIE_LIST_CUR( idx ) - 1) \
+ : 0 )
#ifdef DEBUGGING
for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
SV ** const tmp = av_fetch( revcharmap, state, 0);
if ( tmp ) {
- PerlIO_printf( Perl_debug_log, "%*s",
+ PerlIO_printf( Perl_debug_log, "%*s",
colwidth,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
- )
+ PERL_PV_ESCAPE_FIRSTCHAR
+ )
);
}
}
for( state = 1 ; state < trie->statecount ; state++ ) {
const U32 base = trie->states[ state ].trans.base;
- PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|", (int)depth * 2 + 2,"", (UV)state);
+ PerlIO_printf( Perl_debug_log, "%*s#%4"UVXf"|",
+ (int)depth * 2 + 2,"", (UV)state);
if ( trie->states[ state ].wordnum ) {
- PerlIO_printf( Perl_debug_log, " W%4X", trie->states[ state ].wordnum );
+ PerlIO_printf( Perl_debug_log, " W%4X",
+ trie->states[ state ].wordnum );
} else {
PerlIO_printf( Perl_debug_log, "%6s", "" );
}
while( ( base + ofs < trie->uniquecharcount ) ||
( base + ofs - trie->uniquecharcount < trie->lasttrans
- && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
+ && trie->trans[ base + ofs - trie->uniquecharcount ].check
+ != state))
ofs++;
PerlIO_printf( Perl_debug_log, "+%2"UVXf"[ ", (UV)ofs);
for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
- if ( ( base + ofs >= trie->uniquecharcount ) &&
- ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
- trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
+ if ( ( base + ofs >= trie->uniquecharcount )
+ && ( base + ofs - trie->uniquecharcount
+ < trie->lasttrans )
+ && trie->trans[ base + ofs
+ - trie->uniquecharcount ].check == state )
{
PerlIO_printf( Perl_debug_log, "%*"UVXf,
colwidth,
- (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
+ (UV)trie->trans[ base + ofs
+ - trie->uniquecharcount ].next );
} else {
PerlIO_printf( Perl_debug_log, "%*s",colwidth," ." );
}
}
PerlIO_printf( Perl_debug_log, "\n" );
}
- PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=", (int)depth*2, "");
+ PerlIO_printf(Perl_debug_log, "%*sword_info N:(prev,len)=",
+ (int)depth*2, "");
for (word=1; word <= trie->wordcount; word++) {
PerlIO_printf(Perl_debug_log, " %d:(%d,%d)",
(int)word, (int)(trie->wordinfo[word].prev),
(int)(trie->wordinfo[word].len));
}
PerlIO_printf(Perl_debug_log, "\n" );
-}
+}
/*
Dumps a fully constructed but uncompressed trie in list form.
- List tries normally only are used for construction when the number of
+ List tries normally only are used for construction when the number of
possible chars (trie->uniquecharcount) is very high.
Used for debugging make_trie().
*/
PerlIO_printf( Perl_debug_log, "%*sState :Word | Transition Data\n%*s%s",
(int)depth * 2 + 2,"", (int)depth * 2 + 2,"",
"------:-----+-----------------\n" );
-
+
for( state=1 ; state < next_alloc ; state ++ ) {
U16 charid;
-
+
PerlIO_printf( Perl_debug_log, "%*s %4"UVXf" :",
(int)depth * 2 + 2,"", (UV)state );
if ( ! trie->states[ state ].wordnum ) {
);
}
for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
- SV ** const tmp = av_fetch( 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,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
- PL_colors[0], PL_colors[1],
- (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
+ colwidth,
+ PL_colors[0], PL_colors[1],
+ (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
+ | PERL_PV_ESCAPE_FIRSTCHAR
) ,
TRIE_LIST_ITEM(state,charid).forid,
(UV)TRIE_LIST_ITEM(state,charid).newstate
);
- if (!(charid % 10))
+ if (!(charid % 10))
PerlIO_printf(Perl_debug_log, "\n%*s| ",
(int)((depth * 2) + 14), "");
}
}
PerlIO_printf( Perl_debug_log, "\n");
}
-}
+}
/*
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.
+ This is the normal DFA style state transition table, with a few
+ twists to facilitate compression later.
Used for debugging make_trie().
*/
STATIC void
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
-
+
/*
print out the table precompression so that we can do a visual check
that they are identical.
*/
-
+
PerlIO_printf( Perl_debug_log, "%*sChar : ",(int)depth * 2 + 2,"" );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
SV ** const tmp = av_fetch( revcharmap, charid, 0);
if ( tmp ) {
- PerlIO_printf( Perl_debug_log, "%*s",
+ PerlIO_printf( Perl_debug_log, "%*s",
colwidth,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
- )
+ PERL_PV_ESCAPE_FIRSTCHAR
+ )
);
}
}
for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
- PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
+ PerlIO_printf( Perl_debug_log, "%*s%4"UVXf" : ",
(int)depth * 2 + 2,"",
(UV)TRIE_NODENUM( state ) );
PerlIO_printf( Perl_debug_log, "%*s", colwidth, "." );
}
if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
- PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n", (UV)trie->trans[ state ].check );
+ PerlIO_printf( Perl_debug_log, " (%4"UVXf")\n",
+ (UV)trie->trans[ state ].check );
} else {
- PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n", (UV)trie->trans[ state ].check,
+ PerlIO_printf( Perl_debug_log, " (%4"UVXf") W%4X\n",
+ (UV)trie->trans[ state ].check,
trie->states[ TRIE_NODENUM( state ) ].wordnum );
}
}
\
if ( noper_next < tail ) { \
if (!trie->jump) \
- trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, sizeof(U16) ); \
+ trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, \
+ sizeof(U16) ); \
trie->jump[curword] = (U16)(noper_next - convert); \
if (!jumper) \
jumper = noper_next; \
#define MADE_EXACT_TRIE 4
STATIC I32
-S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth)
+S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
+ regnode *first, regnode *last, regnode *tail,
+ U32 word_count, U32 flags, U32 depth)
{
dVAR;
/* first pass, loop through and scan words */
sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
}
DEBUG_TRIE_COMPILE_r({
- PerlIO_printf( Perl_debug_log,
- "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
- (int)depth * 2 + 2, "",
- REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
- REG_NODE_NUM(last), REG_NODE_NUM(tail),
- (int)depth);
+ PerlIO_printf( Perl_debug_log,
+ "%*smake_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
+ (int)depth * 2 + 2, "",
+ REG_NODE_NUM(startbranch),REG_NODE_NUM(first),
+ REG_NODE_NUM(last), REG_NODE_NUM(tail), (int)depth);
});
-
+
/* Find the node we are going to overwrite */
if ( first == startbranch && OP( last ) != BRANCH ) {
/* whole branch chain */
/* branch sub-chain */
convert = NEXTOPER( first );
}
-
+
/* -- First loop and Setup --
We first traverse the branches and scan each word to determine if it
have unique chars.
We use an array of integers to represent the character codes 0..255
- (trie->charmap) and we use a an HV* to store Unicode characters. We use the
- native representation of the character value as the key and IV's for the
- coded index.
+ (trie->charmap) and we use a an HV* to store Unicode characters. We use
+ the native representation of the character value as the key and IV's for
+ the coded index.
*TODO* If we keep track of how many times each character is used we can
remap the columns so that the table compression later on is more
U32 wordlen = 0; /* required init */
STRLEN minbytes = 0;
STRLEN maxbytes = 0;
- bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the bitmap?*/
+ bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the
+ bitmap?*/
if (OP(noper) == NOTHING) {
regnode *noper_next= regnext(noper);
}
} /* end first pass */
DEBUG_TRIE_COMPILE_r(
- PerlIO_printf( Perl_debug_log, "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
+ PerlIO_printf( Perl_debug_log,
+ "%*sTRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
(int)depth * 2 + 2,"",
( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
(int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
prev_states[1] = 0;
- if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1) > SvIV(re_trie_maxbuff) ) {
+ if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1)
+ > SvIV(re_trie_maxbuff) )
+ {
/*
Second Pass -- Array Of Lists Representation
STRLEN transcount = 1;
- DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
+ DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
"%*sCompiling trie using list compiler\n",
(int)depth * 2 + 2, ""));
if ( uvc < 256 ) {
charid = trie->charmap[ uvc ];
} else {
- SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 0);
+ SV** const svpp = hv_fetch( widecharmap,
+ (char*)&uvc,
+ sizeof( UV ),
+ 0);
if ( !svpp ) {
charid = 0;
} else {
charid=(U16)SvIV( *svpp );
}
}
- /* charid is now 0 if we dont know the char read, or nonzero if we do */
+ /* charid is now 0 if we dont know the char read, or
+ * nonzero if we do */
if ( charid ) {
U16 check;
if ( !trie->states[ state ].trans.list ) {
TRIE_LIST_NEW( state );
}
- for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) {
- if ( TRIE_LIST_ITEM( state, check ).forid == charid ) {
+ for ( check = 1;
+ check <= TRIE_LIST_USED( state );
+ check++ )
+ {
+ if ( TRIE_LIST_ITEM( state, check ).forid
+ == charid )
+ {
newstate = TRIE_LIST_ITEM( state, check ).newstate;
break;
}
} /* end second pass */
/* next alloc is the NEXT state to be allocated */
- trie->statecount = next_alloc;
+ trie->statecount = next_alloc;
trie->states = (reg_trie_state *)
PerlMemShared_realloc( trie->states,
next_alloc
PerlMemShared_realloc( trie->trans,
transcount
* sizeof(reg_trie_trans) );
- Zero( trie->trans + (transcount / 2), transcount / 2 , reg_trie_trans );
+ Zero( trie->trans + (transcount / 2),
+ transcount / 2,
+ reg_trie_trans );
}
base = trie->uniquecharcount + tp - minid;
if ( maxid == minid ) {
for ( ; zp < tp ; zp++ ) {
if ( ! trie->trans[ zp ].next ) {
base = trie->uniquecharcount + zp - minid;
- trie->trans[ zp ].next = TRIE_LIST_ITEM( state, 1).newstate;
+ trie->trans[ zp ].next = TRIE_LIST_ITEM( state,
+ 1).newstate;
trie->trans[ zp ].check = state;
set = 1;
break;
}
}
if ( !set ) {
- trie->trans[ tp ].next = TRIE_LIST_ITEM( state, 1).newstate;
+ trie->trans[ tp ].next = TRIE_LIST_ITEM( state,
+ 1).newstate;
trie->trans[ tp ].check = state;
tp++;
zp = tp;
}
} else {
for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
- const U32 tid = base - trie->uniquecharcount + TRIE_LIST_ITEM( state, idx ).forid;
- trie->trans[ tid ].next = TRIE_LIST_ITEM( state, idx ).newstate;
+ const U32 tid = base
+ - trie->uniquecharcount
+ + TRIE_LIST_ITEM( state, idx ).forid;
+ trie->trans[ tid ].next = TRIE_LIST_ITEM( state,
+ idx ).newstate;
trie->trans[ tid ].check = state;
}
tp += ( maxid - minid + 1 );
we have to use TRIE_NODENUM() to convert.
*/
- DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
+ DEBUG_TRIE_COMPILE_MORE_r( PerlIO_printf( Perl_debug_log,
"%*sCompiling trie using table compiler\n",
(int)depth * 2 + 2, ""));
if ( uvc < 256 ) {
charid = trie->charmap[ uvc ];
} else {
- SV* const * const svpp = hv_fetch( 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 ) {
} else {
Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
}
- /* charid is now 0 if we dont know the char read, or nonzero if we do */
+ /* charid is now 0 if we dont know the char read, or
+ * nonzero if we do */
}
}
accept_state = TRIE_NODENUM( state );
U32 used = trie->trans[ stateidx ].check;
trie->trans[ stateidx ].check = 0;
- for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) {
+ for ( charid = 0;
+ used && charid < trie->uniquecharcount;
+ charid++ )
+ {
if ( flag || trie->trans[ stateidx + charid ].next ) {
if ( trie->trans[ stateidx + charid ].next ) {
if (o_used == 1) {
break;
}
}
- trie->states[ state ].trans.base = zp + trie->uniquecharcount - charid ;
- trie->trans[ zp ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
+ trie->states[ state ].trans.base
+ = zp
+ + trie->uniquecharcount
+ - charid ;
+ trie->trans[ zp ].next
+ = SAFE_TRIE_NODENUM( trie->trans[ stateidx
+ + charid ].next );
trie->trans[ zp ].check = state;
if ( ++zp > pos ) pos = zp;
break;
}
if ( !flag ) {
flag = 1;
- trie->states[ state ].trans.base = pos + trie->uniquecharcount - charid ;
+ trie->states[ state ].trans.base
+ = pos + trie->uniquecharcount - charid ;
}
- trie->trans[ pos ].next = SAFE_TRIE_NODENUM( trie->trans[ stateidx + charid ].next );
+ trie->trans[ pos ].next
+ = SAFE_TRIE_NODENUM(
+ trie->trans[ stateidx + charid ].next );
trie->trans[ pos ].check = state;
pos++;
}
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",
- (int)depth * 2 + 2,"",
- (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1 ),
- (IV)next_alloc,
- (IV)pos,
- ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
+ PerlIO_printf( Perl_debug_log,
+ "%*sAlloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+ (int)depth * 2 + 2,"",
+ (int)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount
+ + 1 ),
+ (IV)next_alloc,
+ (IV)pos,
+ ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
);
} /* end table compress */
}
DEBUG_TRIE_COMPILE_MORE_r(
- PerlIO_printf(Perl_debug_log, "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
+ PerlIO_printf(Perl_debug_log,
+ "%*sStatecount:%"UVxf" Lasttrans:%"UVxf"\n",
(int)depth * 2 + 2, "",
(UV)trie->statecount,
(UV)trie->lasttrans)
PerlMemShared_realloc( trie->trans, trie->lasttrans
* sizeof(reg_trie_trans) );
- { /* Modify the program and insert the new TRIE node */
+ { /* Modify the program and insert the new TRIE node */
U8 nodetype =(U8)(flags & 0xFF);
char *str=NULL;
-
+
#ifdef DEBUGGING
regnode *optimize = NULL;
#ifdef RE_TRACK_PATTERN_OFFSETS
});
}
DEBUG_OPTIMISE_r(
- PerlIO_printf(Perl_debug_log, "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
+ PerlIO_printf(Perl_debug_log,
+ "%*sMJD offset:%"UVuf" MJD length:%"UVuf"\n",
(int)depth * 2 + 2, "",
(UV)mjd_offset, (UV)mjd_nodelen)
);
#endif
- /* But first we check to see if there is a common prefix we can
+ /* 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 && !widecharmap && !trie->jump ) {
PerlIO_printf( Perl_debug_log,
"%*sPrefix State: %"UVuf" Idx:%"UVuf" Char='%s'\n",
(int)depth * 2 + 2, "",
- (UV)state, (UV)idx,
- pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
+ (UV)state, (UV)idx,
+ pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6,
PL_colors[0], PL_colors[1],
(SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_ESCAPE_FIRSTCHAR
+ PERL_PV_ESCAPE_FIRSTCHAR
)
);
});
while (len--)
*str++ = *ch++;
} else {
-#ifdef DEBUGGING
+#ifdef DEBUGGING
if (state>1)
DEBUG_OPTIMISE_r(PerlIO_printf( Perl_debug_log,"]\n"));
#endif
}
}
}
- if (!jumper)
- jumper = last;
+ if (!jumper)
+ jumper = last;
if ( trie->maxlen ) {
NEXT_OFF( convert ) = (U16)(tail - convert);
ARG_SET( convert, data_slot );
- /* Store the offset to the first unabsorbed branch in
- jump[0], which is otherwise unused by the jump logic.
+ /* Store the offset to the first unabsorbed branch in
+ jump[0], which is otherwise unused by the jump logic.
We use this when dumping a trie and during optimisation. */
- if (trie->jump)
+ if (trie->jump)
trie->jump[0] = (U16)(nextbranch - convert);
-
+
/* If the start state is not accepting (meaning there is no empty string/NOTHING)
* and there is a bitmap
* and the first "jump target" node we found leaves enough room
Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char);
PerlMemShared_free(trie->bitmap);
trie->bitmap= NULL;
- } else
+ } else
OP( convert ) = TRIE;
/* store the type in the flags */
convert->flags = nodetype;
DEBUG_r({
- optimize = convert
- + NODE_STEP_REGNODE
+ optimize = convert
+ + NODE_STEP_REGNODE
+ regarglen[ OP( convert ) ];
});
- /* XXX We really should free up the resource in trie now,
+ /* XXX We really should free up the resource in trie now,
as we won't use them - (which resources?) dmq */
}
/* needed for dumping*/
while ( ++opt < optimize) {
Set_Node_Offset_Length(opt,0,0);
}
- /*
- Try to clean up some of the debris left after the
+ /*
+ Try to clean up some of the debris left after the
optimisation.
*/
while( optimize < jumper ) {
#else
SvREFCNT_dec_NN(revcharmap);
#endif
- return trie->jump
- ? MADE_JUMP_TRIE
- : trie->startstate>1
- ? MADE_EXACT_TRIE
+ return trie->jump
+ ? MADE_JUMP_TRIE
+ : trie->startstate>1
+ ? MADE_EXACT_TRIE
: MADE_TRIE;
}
fail[ 0 ] = fail[ 1 ] = 0;
DEBUG_TRIE_COMPILE_r({
PerlIO_printf(Perl_debug_log,
- "%*sStclass Failtable (%"UVuf" states): 0",
+ "%*sStclass Failtable (%"UVuf" states): 0",
(int)(depth * 2), "", (UV)numstates
);
for( q_read=1; q_read<numstates; q_read++ ) {
* time. There are three code points in Unicode whose multi-character folds
* were long ago discovered to mess things up. The previous designs for
* dealing with these involved assigning a special node for them. This
- * approach doesn't work, as evidenced by this example:
+ * approach doesn't always work, as evidenced by this example:
* "\xDFs" =~ /s\xDF/ui # Used to fail before these patches
- * Both these fold to "sss", but if the pattern is parsed to create a node that
+ * Both sides fold to "sss", but if the pattern is parsed to create a node that
* would match just the \xDF, it won't be able to handle the case where a
* successful match would have to cross the node's boundary. The new approach
* that hopefully generally solves the problem generates an EXACTFU_SS node
- * that is "sss".
+ * that is "sss" in this case.
*
* It turns out that there are problems with all multi-character folds, and not
* just these three. Now the code is general, for all such cases. The
* approach taken is:
* 1) This routine examines each EXACTFish node that could contain multi-
- * character fold sequences. It returns in *min_subtract how much to
- * subtract from the the actual length of the string to get a real minimum
- * match length; it is 0 if there are no multi-char folds. This delta is
- * used by the caller to adjust the min length of the match, and the delta
- * between min and max, so that the optimizer doesn't reject these
- * possibilities based on size constraints.
+ * character folded sequences. Since a single character can fold into
+ * such a sequence, the minimum match length for this node is less than
+ * the number of characters in the node. This routine returns in
+ * *min_subtract how much to subtract from the the actual length of the
+ * string to get a real minimum match length; it is 0 if there are no
+ * multi-char foldeds. This delta is used by the caller to adjust the min
+ * length of the match, and the delta between min and max, so that the
+ * optimizer doesn't reject these possibilities based on size constraints.
* 2) For the sequence involving the Sharp s (\xDF), the node type EXACTFU_SS
* is used for an EXACTFU node that contains at least one "ss" sequence in
* it. For non-UTF-8 patterns and strings, this is the only case where
join_exact(pRExC_state,(scan),(min_subtract),has_exactf_sharp_s, (flags),NULL,depth+1)
STATIC U32
-S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, UV *min_subtract, bool *has_exactf_sharp_s, U32 flags,regnode *val, U32 depth) {
+S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan,
+ UV *min_subtract, bool *has_exactf_sharp_s,
+ U32 flags,regnode *val, U32 depth)
+{
/* Merge several consecutive EXACTish nodes into one. */
regnode *n = regnext(scan);
U32 stringok = 1;
&& NEXT_OFF(n)
&& NEXT_OFF(scan) + NEXT_OFF(n) < I16_MAX)
{
-
+
if (OP(n) == TAIL || n > next)
stringok = 0;
if (PL_regkind[OP(n)] == NOTHING) {
/* Don't join if the sum can't fit into a single node */
if (oldl + STR_LEN(n) > U8_MAX)
break;
-
+
DEBUG_PEEP("merg",n,depth);
merged++;
while (s < s_end - 1) /* Can stop 1 before the end, as minimum
length sequence we are looking for is 2 */
{
- int count = 0;
+ int count = 0; /* How many characters in a multi-char fold */
int len = is_MULTI_CHAR_FOLD_utf8_safe(s, s_end);
if (! len) { /* Not a multi-char fold: get next char */
s += UTF8SKIP(s);
/* Peephole optimizer: */
DEBUG_OPTIMISE_MORE_r(
{
- PerlIO_printf(Perl_debug_log,"%*sstudy_chunk stopparen=%ld depth=%lu recursed_depth=%lu ",
- ((int) depth*2), "", (long)stopparen,
- (unsigned long)depth, (unsigned long)recursed_depth);
+ PerlIO_printf(Perl_debug_log,
+ "%*sstudy_chunk stopparen=%ld depth=%lu recursed_depth=%lu ",
+ ((int) depth*2), "", (long)stopparen,
+ (unsigned long)depth, (unsigned long)recursed_depth);
if (recursed_depth) {
U32 i;
U32 j;
|| OP(scan) == IFTHEN) {
next = regnext(scan);
code = OP(scan);
- /* demq: the op(next)==code check is to see if we have "branch-branch" AFAICT */
+ /* demq: the op(next)==code check is to see if we have
+ * "branch-branch" AFAICT */
if (OP(next) == code || code == IFTHEN) {
/* NOTE - There is similar code to this block below for
regnode * const startbranch=scan;
if (flags & SCF_DO_SUBSTR)
- SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge strings after this. */
- if (flags & SCF_DO_STCLASS)
+ SCAN_COMMIT(pRExC_state, data, minlenp); /* Cannot merge
+ strings after
+ this. */
+ if (flags & SCF_DO_STCLASS)
ssc_init_zero(pRExC_state, &accum);
while (OP(scan) == code) {
f |= SCF_WHILEM_VISITED_POS;
/* we suppose the run is continuous, last=next...*/
- minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
- next, &data_fake,
- stopparen, recursed_depth, NULL, f,depth+1);
+ minnext = study_chunk(pRExC_state, &scan, minlenp,
+ &deltanext, next, &data_fake, stopparen,
+ recursed_depth, NULL, f,depth+1);
if (min1 > minnext)
min1 = minnext;
if (deltanext == SSize_t_MAX) {
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
pars++;
if (data_fake.flags & SCF_SEEN_ACCEPT) {
- if ( stopmin > minnext)
+ if ( stopmin > minnext)
stopmin = min + min1;
flags &= ~SCF_DO_SUBSTR;
if (data)
}
}
- if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch ) == BRANCH ) {
+ if (PERL_ENABLE_TRIE_OPTIMISATION && OP( startbranch )
+ == BRANCH )
+ {
/* demq.
Assuming this was/is a branch we are dealing with: 'scan'
'BRANCH EXACT; BRANCH EXACT; BRANCH X'
becomes BRANCH TRIE; BRANCH X;
- There is an additional case, that being where there is a
+ There is an additional case, that being where there is a
common prefix, which gets split out into an EXACT like node
preceding the TRIE node.
U32 count=0;
#ifdef DEBUGGING
- SV * const mysv = sv_newmortal(); /* for dumping */
+ SV * const mysv = sv_newmortal(); /* for dumping */
#endif
/* var tail is used because there may be a TAIL
regop in the way. Ie, the exacts will point to the
tail = regnext( tail );
}
-
+
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, mysv, tail );
PerlIO_printf( Perl_debug_log, "%*s%s%s\n",
- (int)depth * 2 + 2, "",
- "Looking for TRIE'able sequences. Tail node is: ",
- SvPV_nolen_const( mysv )
+ (int)depth * 2 + 2, "",
+ "Looking for TRIE'able sequences. Tail node is: ",
+ SvPV_nolen_const( mysv )
);
});
-
+
/*
Step through the branches
}
PerlIO_printf( Perl_debug_log, "(First==%d,Last==%d,Cur==%d,tt==%s,nt==%s,nnt==%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]
+ PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype]
);
});
* so we leave it in for now. */
if ( trietype && trietype != NOTHING )
make_trie( pRExC_state,
- startbranch, first, cur, tail, count,
- trietype, depth+1 );
+ startbranch, first, cur, tail,
+ count, trietype, depth+1 );
last = NULL; /* note: we clear/update
first, trietype etc below,
so we dont do it here */
DEBUG_TRIE_COMPILE_r({
regprop(RExC_rx, mysv, cur);
PerlIO_printf( Perl_debug_log,
- "%*s- %s (%d) <SCAN FINISHED>\n", (int)depth * 2 + 2,
+ "%*s- %s (%d) <SCAN FINISHED>\n",
+ (int)depth * 2 + 2,
"", SvPV_nolen_const( mysv ),REG_NODE_NUM(cur));
});
/* the last branch of the sequence was part of
* a trie, so we have to construct it here
* outside of the loop */
- made= make_trie( pRExC_state, startbranch, first, scan, tail, count, trietype, depth+1 );
+ made= make_trie( pRExC_state, startbranch,
+ first, scan, tail, count,
+ trietype, depth+1 );
#ifdef TRIE_STUDY_OPT
if ( ((made == MADE_EXACT_TRIE &&
startbranch == first)
}
} /* end if ( last) */
} /* TRIE_MAXBUF is non zero */
-
+
} /* do trie */
-
+
}
else if ( code == BRANCHJ ) { /* single branch is optimized. */
scan = NEXTOPER(NEXTOPER(scan));
Newx(newframe,1,scan_frame);
} else {
DEBUG_STUDYDATA("inf:", data,depth);
- /* some form of infinite recursion, assume infinite length */
+ /* some form of infinite recursion, assume infinite length
+ * */
if (flags & SCF_DO_SUBSTR) {
SCAN_COMMIT(pRExC_state,data,minlenp);
data->longest = &(data->longest_float);
mg_find(sv, PERL_MAGIC_utf8) : NULL;
if (mg && mg->mg_len >= 0)
mg->mg_len += utf8_length((U8*)STRING(scan),
- (U8*)STRING(scan)+STR_LEN(scan));
+ (U8*)STRING(scan)+STR_LEN(scan));
}
data->last_end = data->pos_min + l;
data->pos_min += l; /* As in the first entry. */
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;
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) {
f &= ~SCF_WHILEM_VISITED_POS;
/* This will finish on WHILEM, setting scan, or on NULL: */
- minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
- last, data, stopparen, recursed_depth, NULL,
- (mincount == 0
- ? (f & ~SCF_DO_SUBSTR) : f),depth+1);
+ minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext,
+ last, data, stopparen, recursed_depth, NULL,
+ (mincount == 0
+ ? (f & ~SCF_DO_SUBSTR)
+ : f)
+ ,depth+1);
if (flags & SCF_DO_STCLASS)
data->start_class = oclass;
&& (next_is_eval || !(mincount == 0 && maxcount == 1))
&& (minnext == 0) && (deltanext == 0)
&& data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR))
- && maxcount <= REG_INFTY/3) /* Complement check for big count */
+ && maxcount <= REG_INFTY/3) /* Complement check for big
+ count */
{
/* Fatal warnings may leak the regexp without this: */
SAVEFREESV(RExC_rx_sv);
ckWARNreg(RExC_parse,
- "Quantifier unexpected on zero-length expression");
+ "Quantifier unexpected on zero-length expression");
(void)ReREFCNT_inc(RExC_rx_sv);
}
min += minnext * mincount;
is_inf_internal |= deltanext == SSize_t_MAX
- || (maxcount == REG_INFTY && minnext + deltanext > 0);
+ || (maxcount == REG_INFTY && minnext + deltanext > 0);
is_inf |= is_inf_internal;
if (is_inf)
delta = SSize_t_MAX;
else
- delta += (minnext + deltanext) * maxcount - minnext * mincount;
+ delta += (minnext + deltanext) * maxcount
+ - minnext * mincount;
/* Try powerful optimization CURLYX => CURLYN. */
if ( OP(oscan) == CURLYX && data
SV *last_str = NULL;
int counted = mincount != 0;
- if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
+ if (data->last_end > 0 && mincount != 0) { /* Ends with a
+ string. */
SSize_t b = pos_before >= data->last_start_min
? pos_before : data->last_start_min;
STRLEN l;
if (mincount > 1) {
SvGROW(last_str, (mincount * l) + 1);
repeatcpy(SvPVX(last_str) + l,
- SvPVX_const(last_str), l, mincount - 1);
+ SvPVX_const(last_str), l,
+ mincount - 1);
SvCUR_set(last_str, SvCUR(last_str) * mincount);
/* Add additional parts. */
SvCUR_set(data->last_found,
(UV)(-counted * deltanext + (minnext + deltanext) * maxcount
- minnext * mincount), (UV)(SSize_t_MAX - data->pos_delta));
#endif
- if (deltanext == SSize_t_MAX ||
- -counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount >= SSize_t_MAX - data->pos_delta)
+ if (deltanext == SSize_t_MAX
+ || -counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount >= SSize_t_MAX - data->pos_delta)
data->pos_delta = SSize_t_MAX;
else
data->pos_delta += - counted * deltanext +
case REF:
case CLUMP:
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;
min++;
delta++; /* Because of the 2 char string cr-lf */
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 += 1;
data->pos_delta += 1;
data->longest = &(data->longest_float);
default:
#ifdef DEBUGGING
- Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan));
+ Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d",
+ OP(scan));
#endif
case CANY:
case SANY:
/*DEBUG_PARSE_MSG("opfail");*/
regprop(RExC_rx, mysv_val, upto);
- PerlIO_printf(Perl_debug_log, "~ replace with OPFAIL pointed at %s (%"IVdf") offset %"IVdf"\n",
- SvPV_nolen_const(mysv_val),
- (IV)REG_NODE_NUM(upto),
- (IV)(upto - scan)
+ PerlIO_printf(Perl_debug_log,
+ "~ replace with OPFAIL pointed at %s (%"IVdf") offset %"IVdf"\n",
+ SvPV_nolen_const(mysv_val),
+ (IV)REG_NODE_NUM(upto),
+ (IV)(upto - scan)
);
});
OP(scan) = OPFAIL;
scan= upto;
continue;
}
- if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
+ if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
|| OP(scan) == UNLESSM )
{
/* Negative Lookahead/lookbehind
f |= SCF_WHILEM_VISITED_POS;
next = regnext(scan);
nscan = NEXTOPER(NEXTOPER(scan));
- minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
- last, &data_fake, stopparen, recursed_depth, NULL, f, depth+1);
+ minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
+ last, &data_fake, stopparen,
+ recursed_depth, NULL, f, depth+1);
if (scan->flags) {
if (deltanext) {
FAIL("Variable length lookbehind not implemented");
}
else if (minnext > (I32)U8_MAX) {
- FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
+ FAIL2("Lookbehind longer than %"UVuf" not implemented",
+ (UV)U8_MAX);
}
scan->flags = (U8)minnext;
}
regnode *nscan;
regnode_ssc intrnl;
int f = 0;
- /* We use SAVEFREEPV so that when the full compile
- is finished perl will clean up the allocated
+ /* We use SAVEFREEPV so that when the full compile
+ is finished perl will clean up the allocated
minlens when it's all done. This way we don't
have to worry about freeing them when we know
they wont be used, which would be a pain.
StructCopy(data, &data_fake, scan_data_t);
if ((flags & SCF_DO_SUBSTR) && data->last_found) {
f |= SCF_DO_SUBSTR;
- if (scan->flags)
+ if (scan->flags)
SCAN_COMMIT(pRExC_state, &data_fake,minlenp);
data_fake.last_found=newSVsv(data->last_found);
}
next = regnext(scan);
nscan = NEXTOPER(NEXTOPER(scan));
- *minnextp = study_chunk(pRExC_state, &nscan, minnextp, &deltanext,
- last, &data_fake, stopparen, recursed_depth, NULL, f,depth+1);
+ *minnextp = study_chunk(pRExC_state, &nscan, minnextp,
+ &deltanext, last, &data_fake,
+ stopparen, recursed_depth, NULL,
+ f,depth+1);
if (scan->flags) {
if (deltanext) {
FAIL("Variable length lookbehind not implemented");
}
else if (*minnextp > (I32)U8_MAX) {
- FAIL2("Lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX);
+ FAIL2("Lookbehind longer than %"UVuf" not implemented",
+ (UV)U8_MAX);
}
scan->flags = (U8)*minnextp;
}
RExC_rx->minlen=*minnextp;
SCAN_COMMIT(pRExC_state, &data_fake, minnextp);
SvREFCNT_dec_NN(data_fake.last_found);
-
- if ( data_fake.minlen_fixed != minlenp )
+
+ if ( data_fake.minlen_fixed != minlenp )
{
data->offset_fixed= data_fake.offset_fixed;
data->minlen_fixed= data_fake.minlen_fixed;
}
else if (OP(scan) == GPOS) {
if (!(RExC_rx->extflags & RXf_GPOS_FLOAT) &&
- !(delta || is_inf || (data && data->pos_delta)))
+ !(delta || is_inf || (data && data->pos_delta)))
{
if (!(RExC_rx->extflags & RXf_ANCH) && (flags & SCF_DO_SUBSTR))
RExC_rx->extflags |= RXf_ANCH_GPOS;
} else {
RExC_rx->extflags |= RXf_GPOS_FLOAT;
RExC_rx->gofs = 0;
- }
+ }
}
#ifdef TRIE_STUDY_OPT
#ifdef FULL_TRIE_STUDY
regnode_ssc 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)
ssc_init_zero(pRExC_state, &accum);
-
+
if (!trie->jump) {
min1= trie->minlen;
max1= trie->maxlen;
} else {
const regnode *nextbranch= NULL;
U32 word;
-
- for ( word=1 ; word <= trie->wordcount ; word++)
+
+ for ( word=1 ; word <= trie->wordcount ; word++)
{
SSize_t deltanext=0, minnext=0, f = 0, fake;
regnode_ssc this_class;
-
+
data_fake.flags = 0;
if (data) {
data_fake.whilem_c = data->whilem_c;
}
if (flags & SCF_WHILEM_VISITED_POS)
f |= SCF_WHILEM_VISITED_POS;
-
+
if (trie->jump[word]) {
if (!nextbranch)
nextbranch = trie_node + trie->jump[0];
scan= trie_node + trie->jump[word];
/* We go from the jump point to the branch that follows
- it. Note this means we need the vestigal unused branches
- even though they arent otherwise used.
- */
- minnext = study_chunk(pRExC_state, &scan, minlenp,
- &deltanext, (regnode *)nextbranch, &data_fake,
+ it. Note this means we need the vestigal unused
+ branches even though they arent otherwise used. */
+ minnext = study_chunk(pRExC_state, &scan, minlenp,
+ &deltanext, (regnode *)nextbranch, &data_fake,
stopparen, recursed_depth, NULL, f,depth+1);
}
if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
nextbranch= regnext((regnode*)nextbranch);
-
+
if (min1 > (SSize_t)(minnext + trie->minlen))
min1 = minnext + trie->minlen;
if (deltanext == SSize_t_MAX) {
max1 = SSize_t_MAX;
} else if (max1 < (SSize_t)(minnext + deltanext + trie->maxlen))
max1 = minnext + deltanext + trie->maxlen;
-
+
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
pars++;
if (data_fake.flags & SCF_SEEN_ACCEPT) {
- if ( stopmin > min + min1)
+ if ( stopmin > min + min1)
stopmin = min + min1;
flags &= ~SCF_DO_SUBSTR;
if (data)
else if (PL_regkind[OP(scan)] == TRIE) {
reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ];
U8*bang=NULL;
-
+
min += trie->minlen;
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)
data->longest = &(data->longest_float);
}
if (trie->jump) /* no more substrings -- for now /grr*/
- flags &= ~SCF_DO_SUBSTR;
+ flags &= ~SCF_DO_SUBSTR;
}
#endif /* old or new */
#endif /* TRIE_STUDY_OPT */
ssc_and(pRExC_state, data->start_class, and_withp);
if (flags & SCF_TRIE_RESTUDY)
data->flags |= SCF_TRIE_RESTUDY;
-
+
DEBUG_STUDYDATA("post-fin:",data,depth);
-
+
return min < stopmin ? min : stopmin;
}
} STMT_END
#else
#define CHECK_RESTUDY_GOTO_butfirst
-#endif
+#endif
/*
* pregcomp - compile a regular expression into internal code
* scope
*/
-#ifndef PERL_IN_XSUB_RE
+#ifndef PERL_IN_XSUB_RE
/* return the currently in-scope regex engine (or the default if none) */
if (oplist) {
assert(oplist->op_type == OP_PADAV
- || oplist->op_type == OP_RV2AV);
+ || oplist->op_type == OP_RV2AV);
oplist = oplist->op_sibling;;
}
STATIC bool
-S_setup_longest(pTHX_ RExC_state_t *pRExC_state, SV* sv_longest, SV** rx_utf8, SV** rx_substr, SSize_t* rx_end_shift,
- SSize_t lookbehind, SSize_t offset, SSize_t *minlen, STRLEN longest_length, bool eol, bool meol)
+S_setup_longest(pTHX_ RExC_state_t *pRExC_state, SV* sv_longest,
+ SV** rx_utf8, SV** rx_substr, SSize_t* rx_end_shift,
+ SSize_t lookbehind, SSize_t offset, SSize_t *minlen,
+ STRLEN longest_length, bool eol, bool meol)
{
/* This is the common code for setting up the floating and fixed length
* string data extracted from Perl_re_op_compile() below. Returns a boolean
scan_data_t data;
RExC_state_t RExC_state;
RExC_state_t * const pRExC_state = &RExC_state;
-#ifdef TRIE_STUDY_OPT
+#ifdef TRIE_STUDY_OPT
int restudied = 0;
RExC_state_t copyRExC_state;
-#endif
+#endif
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_RE_OP_COMPILE;
PL_UpperLatin1 = _new_invlist_C_array(UpperLatin1_invlist);
PL_utf8_foldable = _new_invlist_C_array(_Perl_Any_Folds_invlist);
- PL_HasMultiCharFold = _new_invlist_C_array(_Perl_Multi_Char_Folds_invlist);
+ PL_HasMultiCharFold =
+ _new_invlist_C_array(_Perl_Multi_Char_Folds_invlist);
}
#endif
runtime_code = S_has_runtime_code(aTHX_ pRExC_state, exp, plen);
/* return old regex if pattern hasn't changed */
- /* XXX: note in the below we have to check the flags as well as the pattern.
+ /* XXX: note in the below we have to check the flags as well as the
+ * pattern.
*
- * Things get a touch tricky as we have to compare the utf8 flag independently
- * from the compile flags.
- */
+ * Things get a touch tricky as we have to compare the utf8 flag
+ * independently from the compile flags. */
if ( old_re
&& !recompile
SvLEN_set(code_blocksv,0); /* no you can't have it, sv_clear */
DEBUG_PARSE_r({
- PerlIO_printf(Perl_debug_log,
+ PerlIO_printf(Perl_debug_log,
"Required size %"IVdf" nodes\n"
- "Starting second pass (creation)\n",
+ "Starting second pass (creation)\n",
(IV)RExC_size);
- RExC_lastnum=0;
- RExC_lastparse=NULL;
+ RExC_lastnum=0;
+ RExC_lastparse=NULL;
});
/* The first pass could have found things that force Unicode semantics */
if (RExC_whilem_seen > 15)
RExC_whilem_seen = 15;
- /* Allocate space and zero-initialize. Note, the two step process
- of zeroing when in debug mode, thus anything assigned has to
+ /* Allocate space and zero-initialize. Note, the two step process
+ of zeroing when in debug mode, thus anything assigned has to
happen after that */
rx = (REGEXP*) newSV_type(SVt_REGEXP);
r = ReANY(rx);
FAIL("Regexp out of space");
#ifdef DEBUGGING
/* avoid reading uninitialized memory in DEBUGGING code in study_chunk() */
- Zero(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode), char);
-#else
+ Zero(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode),
+ char);
+#else
/* bulk initialize base fields with 0. */
- Zero(ri, sizeof(regexp_internal), char);
+ Zero(ri, sizeof(regexp_internal), char);
#endif
/* non-zero initialization begins here */
{
bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
- bool has_charset = (get_regex_charset(r->extflags) != REGEX_DEPENDS_CHARSET);
+ bool has_charset = (get_regex_charset(r->extflags)
+ != REGEX_DEPENDS_CHARSET);
/* The caret is output if there are any defaults: if not all the STD
* flags are set, or if no character set specifier is needed */
bool has_default =
(((r->extflags & RXf_PMf_STD_PMMOD) != RXf_PMf_STD_PMMOD)
|| ! has_charset);
- bool has_runon = ((RExC_seen & REG_SEEN_RUN_ON_COMMENT)==REG_SEEN_RUN_ON_COMMENT);
+ bool has_runon = ((RExC_seen & REG_SEEN_RUN_ON_COMMENT)
+ == REG_SEEN_RUN_ON_COMMENT);
U16 reganch = (U16)((r->extflags & RXf_PMf_STD_PMMOD)
>> RXf_PMf_STD_PMMOD_SHIFT);
const char *fptr = STD_PAT_MODS; /*"msix"*/
* So its 1 if there are no parens. */
RExC_study_chunk_recursed_bytes= (RExC_npar >> 3) +
((RExC_npar & 0x07) != 0);
- Newx(RExC_study_chunk_recursed, RExC_study_chunk_recursed_bytes * RExC_npar, U8);
+ Newx(RExC_study_chunk_recursed,
+ RExC_study_chunk_recursed_bytes * RExC_npar, U8);
SAVEFREEPV(RExC_study_chunk_recursed);
}
REGC((U8)REG_MAGIC, (char*) RExC_emit++);
if (reg(pRExC_state, 0, &flags,1) == NULL) {
- ReREFCNT_dec(rx);
+ ReREFCNT_dec(rx);
Perl_croak(aTHX_ "panic: reg returned NULL to re_op_compile for generation pass, flags=%#"UVxf"", (UV) flags);
}
/* XXXX To minimize changes to RE engine we always allocate
r->minlen = minlen = sawlookahead = sawplus = sawopen = sawminmod = 0;
Zero(r->substrs, 1, struct reg_substr_data);
if (RExC_study_chunk_recursed)
- Zero(RExC_study_chunk_recursed, RExC_study_chunk_recursed_bytes * RExC_npar, U8);
+ Zero(RExC_study_chunk_recursed,
+ RExC_study_chunk_recursed_bytes * RExC_npar, U8);
#ifdef TRIE_STUDY_OPT
if (!restudied) {
} else {
U32 seen=RExC_seen;
DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log,"Restudying\n"));
-
+
RExC_state = copyRExC_state;
- if (seen & REG_TOP_LEVEL_BRANCHES)
+ if (seen & REG_TOP_LEVEL_BRANCHES)
RExC_seen |= REG_TOP_LEVEL_BRANCHES;
else
RExC_seen &= ~REG_TOP_LEVEL_BRANCHES;
}
#else
StructCopy(&zero_scan_data, &data, scan_data_t);
-#endif
+#endif
/* Dig out information for optimizations. */
r->extflags = RExC_flags; /* was pm_op */
/*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */
-
+
if (UTF)
SvUTF8_on(rx); /* Unicode in it? */
ri->regstclass = NULL;
/* testing for BRANCH here tells us whether there is "must appear"
data in the pattern. If there is then we can use it for optimisations */
- if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES)) { /* Only one top-level choice. */
+ if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES)) { /* Only one top-level choice.
+ */
SSize_t fake;
STRLEN longest_float_length, longest_fixed_length;
regnode_ssc ch_class; /* pointed to by data */
regnode *first_next= regnext(first);
/*
* Skip introductions and multiplicators >= 1
- * so that we can extract the 'meat' of the pattern that must
+ * so that we can extract the 'meat' of the pattern that must
* match in the large if() sequence following.
* NOTE that EXACT is NOT covered here, as it is normally
- * picked up by the optimiser separately.
+ * picked up by the optimiser separately.
*
* This is unfortunate as the optimiser isnt handling lookahead
* properly currently.
(PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) ||
(OP(first) == NOTHING && PL_regkind[OP(first_next)] != END ))
{
- /*
+ /*
* the only op that could be a regnode is PLUS, all the rest
* will be regnode_1 or regnode_2.
*
}
#ifdef TRIE_STCLASS
else if (PL_regkind[OP(first)] == TRIE &&
- ((reg_trie_data *)ri->data->data[ ARG(first) ])->minlen>0)
+ ((reg_trie_data *)ri->data->data[ ARG(first) ])->minlen>0)
{
regnode *trie_op;
/* this can happen only on restudy */
first = NEXTOPER(first);
goto again;
}
- if (sawplus && !sawminmod && !sawlookahead && (!sawopen || !RExC_sawback)
+ if (sawplus && !sawminmod && !sawlookahead
+ && (!sawopen || !RExC_sawback)
&& !pRExC_state->num_code_blocks) /* May examine pos and $& */
/* x+ must match at the 1st pos of run of x's */
r->intflags |= PREGf_SKIP;
} else /* XXXX Check for BOUND? */
stclass_flag = 0;
data.last_closep = &last_close;
-
+
DEBUG_RExC_seen();
- minlen = study_chunk(pRExC_state, &first, &minlen, &fake, scan + RExC_size, /* Up to end */
+ minlen = study_chunk(pRExC_state, &first, &minlen, &fake,
+ scan + RExC_size, /* Up to end */
&data, -1, 0, NULL,
SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag
| (restudied ? SCF_TRIE_DOING_RESTUDY : 0),
data.start_class = NULL;
}
- /* A temporary algorithm prefers floated substr to fixed one to dig more info. */
+ /* A temporary algorithm prefers floated substr to fixed one to dig
+ * more info. */
if (longest_fixed_length > longest_float_length) {
r->check_end_shift = r->anchored_end_shift;
r->check_substr = r->anchored_substr;
if ( (STRLEN)minlen < longest_float_length )
minlen= longest_float_length;
if ( (STRLEN)minlen < longest_fixed_length )
- minlen= longest_fixed_length;
+ minlen= longest_fixed_length;
*/
}
else {
ssc_init(pRExC_state, &ch_class);
data.start_class = &ch_class;
data.last_closep = &last_close;
-
+
DEBUG_RExC_seen();
- minlen = study_chunk(pRExC_state, &scan, &minlen, &fake, scan + RExC_size,
- &data, -1, 0, NULL,
- SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS
- |(restudied ? SCF_TRIE_DOING_RESTUDY : 0),
+ minlen = study_chunk(pRExC_state,
+ &scan, &minlen, &fake, scan + RExC_size, &data, -1, 0, NULL,
+ SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied
+ ? SCF_TRIE_DOING_RESTUDY
+ : 0),
0);
-
+
CHECK_RESTUDY_GOTO_butfirst(NOOP);
r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8
(IV)minlen, (IV)r->minlen);
});
r->minlenret = minlen;
- if (r->minlen < minlen)
+ if (r->minlen < minlen)
r->minlen = minlen;
-
+
if (RExC_seen & REG_SEEN_GPOS)
r->extflags |= RXf_GPOS_SEEN;
if (RExC_seen & REG_SEEN_LOOKBEHIND)
- r->extflags |= RXf_NO_INPLACE_SUBST; /* inplace might break the lookbehind */
+ r->extflags |= RXf_NO_INPLACE_SUBST; /* inplace might break the
+ lookbehind */
if (pRExC_state->num_code_blocks)
r->extflags |= RXf_EVAL_SEEN;
if (RExC_seen & REG_SEEN_CANY)
r->extflags |= RXf_NULL;
else if (PL_regkind[fop] == BOL && nop == END)
r->extflags |= RXf_START_ONLY;
- else if (fop == PLUS && PL_regkind[nop] == POSIXD && FLAGS(next) == _CC_SPACE && OP(regnext(first)) == END)
+ else if (fop == PLUS
+ && PL_regkind[nop] == POSIXD && FLAGS(next) == _CC_SPACE
+ && OP(regnext(first)) == END)
r->extflags |= RXf_WHITE;
- else if ( r->extflags & RXf_SPLIT && fop == EXACT && STR_LEN(first) == 1 && *(STRING(first)) == ' ' && OP(regnext(first)) == END )
+ else if ( r->extflags & RXf_SPLIT
+ && fop == EXACT
+ && STR_LEN(first) == 1
+ && *(STRING(first)) == ' '
+ && OP(regnext(first)) == END )
r->extflags |= (RXf_SKIPWHITE|RXf_WHITE);
}
#ifdef DEBUGGING
if (RExC_paren_names) {
ri->name_list_idx = add_data( pRExC_state, STR_WITH_LEN("a"));
- ri->data->data[ri->name_list_idx] = (void*)SvREFCNT_inc(RExC_paren_name_list);
+ ri->data->data[ri->name_list_idx]
+ = (void*)SvREFCNT_inc(RExC_paren_name_list);
} else
#endif
ri->name_list_idx = 0;
const STRLEN len = ri->u.offsets[0];
STRLEN i;
GET_RE_DEBUG_FLAGS_DECL;
- PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)ri->u.offsets[0]);
+ PerlIO_printf(Perl_debug_log,
+ "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])
PerlIO_printf(Perl_debug_log, "%"UVuf":%"UVuf"[%"UVuf"] ",
else if (flags & RXapif_NEXTKEY)
return reg_named_buff_nextkey(rx, flags);
else {
- Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_iter", (int)flags);
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_iter",
+ (int)flags);
return NULL;
}
}
SvREFCNT_dec_NN(ret);
return newSViv(length + 1);
} else {
- Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", (int)flags);
+ Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar",
+ (int)flags);
return NULL;
}
}
I32 n = paren;
PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_FETCH;
-
+
if ( n == RX_BUFF_IDX_CARET_PREMATCH
|| n == RX_BUFF_IDX_CARET_FULLMATCH
|| n == RX_BUFF_IDX_CARET_POSTMATCH
i = rx->offs[0].start;
s = rx->subbeg;
}
- else
+ else
if ((n == RX_BUFF_IDX_POSTMATCH || n == RX_BUFF_IDX_CARET_POSTMATCH)
&& rx->offs[0].end != -1)
{
/* $', ${^POSTMATCH} */
s = rx->subbeg - rx->suboffset + rx->offs[0].end;
i = rx->sublen + rx->suboffset - rx->offs[0].end;
- }
+ }
else
if ( 0 <= n && n <= (I32)rx->nparens &&
(s1 = rx->offs[n].start) != -1 &&
s = rx->subbeg + s1 - rx->suboffset;
} else {
goto ret_undef;
- }
+ }
assert(s >= rx->subbeg);
assert((STRLEN)rx->sublen >= (STRLEN)((s - rx->subbeg) + i) );
TAINT;
SvTAINT(sv);
}
- } else
+ } else
SvTAINTED_off(sv);
}
} else {
RExC_parse++;
} while (isWORDCHAR(*RExC_parse));
} else {
- RExC_parse++; /* so the <- from the vFAIL is after the offending character */
+ RExC_parse++; /* so the <- from the vFAIL is after the offending
+ character */
vFAIL("Group name must start with a non-digit word character");
}
if ( flags ) {
}
STATIC void
-S__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end)
+S__append_range_to_invlist(pTHX_ SV* const invlist,
+ const UV start, const UV end)
{
/* Subject to change or removal. Append the range from 'start' to 'end' at
* the end of the inversion list. The range must be above any existing
|| ELEMENT_RANGE_MATCHES_INVLIST(final_element))
{
Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%"UVuf", start=%"UVuf", match=%c",
- array[final_element], start,
- ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f');
+ array[final_element], start,
+ ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f');
}
/* Here, it is a legal append. If the new range begins with the first
}
void
-Perl__invlist_populate_swatch(pTHX_ SV* const invlist, const UV start, const UV end, U8* swatch)
+Perl__invlist_populate_swatch(pTHX_ SV* const invlist,
+ const UV start, const UV end, U8* swatch)
{
/* populates a swatch of a swash the same way swatch_get() does in utf8.c,
* but is used when the swash has an inversion list. This makes this much
}
void
-Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, const bool complement_b, SV** output)
+Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
+ const bool complement_b, SV** output)
{
/* Take the union of two inversion lists and point <output> to it. *output
* SHOULD BE DEFINED upon input, and if it points to one of the two lists,
}
void
-Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, const bool complement_b, SV** i)
+Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b,
+ const bool complement_b, SV** i)
{
/* Take the intersection of two inversion lists and point <i> to it. *i
* SHOULD BE DEFINED upon input, and if it points to one of the two lists,
}
/* The final length is what we've output so far plus what else is in the
- * intersection. At most one of the subexpressions below will be non-zero */
+ * intersection. At most one of the subexpressions below will be non-zero
+ * */
len_r = i_r;
if (count >= 2) {
len_r += (len_a - i_a) + (len_b - i_b);
}
SV*
-Perl__setup_canned_invlist(pTHX_ const STRLEN size, const UV element0, UV** other_elements_ptr)
+Perl__setup_canned_invlist(pTHX_ const STRLEN size, const UV element0,
+ UV** other_elements_ptr)
{
/* Create and return an inversion list whose contents are to be populated
* by the caller. The caller gives the number of elements (in 'size') and
#ifndef PERL_IN_XSUB_RE
void
-Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, const char * const indent, SV* const invlist)
+Perl__invlist_dump(pTHX_ PerlIO *file, I32 level,
+ const char * const indent, SV* const invlist)
{
/* Designed to be called only by do_sv_dump(). Dumps out the ranges of the
* inversion list 'invlist' to 'file' at 'level' Each line is prefixed by
vFAIL2("Regexp modifier \"%c\" may appear a maximum of twice", ASCII_RESTRICT_PAT_MOD);
}
else if (has_charset_modifier == *(RExC_parse - 1)) {
- vFAIL2("Regexp modifier \"%c\" may not appear twice", *(RExC_parse - 1));
+ vFAIL2("Regexp modifier \"%c\" may not appear twice",
+ *(RExC_parse - 1));
}
else {
vFAIL3("Regexp modifiers \"%c\" and \"%c\" are mutually exclusive", has_charset_modifier, *(RExC_parse - 1));
/*NOTREACHED*/
neg_modifier:
RExC_parse++;
- vFAIL2("Regexp modifier \"%c\" may not appear after the \"-\"", *(RExC_parse - 1));
+ vFAIL2("Regexp modifier \"%c\" may not appear after the \"-\"",
+ *(RExC_parse - 1));
/*NOTREACHED*/
case ONCE_PAT_MOD: /* 'o' */
case GLOBAL_PAT_MOD: /* 'g' */
if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
- const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G;
+ const I32 wflagbit = *RExC_parse == 'o'
+ ? WASTED_O
+ : WASTED_G;
if (! (wastedflags & wflagbit) ) {
wastedflags |= wflagbit;
/* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */
char *start_arg = NULL;
unsigned char op = 0;
int argok = 1;
- int internal_argval = 0; /* internal_argval is only useful if !argok */
+ int internal_argval = 0; /* internal_argval is only useful if
+ !argok */
if (has_intervening_patws && SIZE_ONLY) {
ckWARNregdep(RExC_parse + 1, "In '(*VERB...)', splitting the initial '(*' is deprecated");
verb_len = RExC_parse - start_verb;
if ( start_arg ) {
RExC_parse++;
- while ( *RExC_parse && *RExC_parse != ')' )
+ while ( *RExC_parse && *RExC_parse != ')' )
RExC_parse++;
- if ( *RExC_parse != ')' )
+ if ( *RExC_parse != ')' )
vFAIL("Unterminated verb pattern argument");
if ( RExC_parse == start_arg )
start_arg = NULL;
if ( *RExC_parse != ')' )
vFAIL("Unterminated verb pattern");
}
-
+
switch ( *start_verb ) {
case 'A': /* (*ACCEPT) */
if ( memEQs(start_verb,verb_len,"ACCEPT") ) {
if ( memEQs(start_verb,verb_len,"PRUNE") )
op = PRUNE;
break;
- case 'S': /* (*SKIP) */
- if ( memEQs(start_verb,verb_len,"SKIP") )
+ case 'S': /* (*SKIP) */
+ if ( memEQs(start_verb,verb_len,"SKIP") )
op = SKIP;
break;
case 'T': /* (*THEN) */
if ( argok ) {
if ( start_arg && internal_argval ) {
vFAIL3("Verb pattern '%.*s' may not have an argument",
- verb_len, start_verb);
+ verb_len, start_verb);
} else if ( argok < 0 && !start_arg ) {
vFAIL3("Verb pattern '%.*s' has a mandatory argument",
- verb_len, start_verb);
+ verb_len, start_verb);
} else {
ret = reganode(pRExC_state, op, internal_argval);
if ( ! internal_argval && ! SIZE_ONLY ) {
if (start_arg) {
- SV *sv = newSVpvn( start_arg, RExC_parse - start_arg);
- ARG(ret) = add_data( pRExC_state, STR_WITH_LEN("S"));
+ SV *sv = newSVpvn( start_arg,
+ RExC_parse - start_arg);
+ ARG(ret) = add_data( pRExC_state,
+ STR_WITH_LEN("S"));
RExC_rxi->data->data[ARG(ret)]=(void*)sv;
ret->flags = 0;
} else {
- ret->flags = 1;
+ ret->flags = 1;
}
- }
+ }
}
if (!internal_argval)
RExC_seen |= REG_SEEN_VERBARG;
} else if ( start_arg ) {
vFAIL3("Verb pattern '%.*s' may not have an argument",
- verb_len, start_verb);
+ verb_len, start_verb);
} else {
ret = reg_node(pRExC_state, op);
}
goto named_recursion;
}
else if (paren == '=') { /* (?P=...) named backref */
- /* this pretty much dupes the code for \k<NAME> in regatom(), if
- you change this make sure you change that */
+ /* this pretty much dupes the code for \k<NAME> 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,
}
RExC_parse++;
/* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
- vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
+ vFAIL3("Sequence (%.*s...) not recognized",
+ RExC_parse-seqstart, seqstart);
/*NOTREACHED*/
case '<': /* (?<...) */
if (*RExC_parse == '!')
paren = ',';
- else if (*RExC_parse != '=')
+ else if (*RExC_parse != '=')
named_capture:
{ /* (?<...>) */
char *name_start;
}
}
if ( count ) {
- pv = (I32*)SvGROW(sv_dat, SvCUR(sv_dat) + sizeof(I32)+1);
+ pv = (I32*)SvGROW(sv_dat,
+ SvCUR(sv_dat) + sizeof(I32)+1);
SvCUR_set(sv_dat, SvCUR(sv_dat) + sizeof(I32));
pv[count] = RExC_npar;
SvIV_set(sv_dat, SvIVX(sv_dat) + 1);
}
} else {
(void)SvUPGRADE(sv_dat,SVt_PVNV);
- sv_setpvn(sv_dat, (char *)&(RExC_npar), sizeof(I32));
+ sv_setpvn(sv_dat, (char *)&(RExC_npar),
+ sizeof(I32));
SvIOK_on(sv_dat);
SvIV_set(sv_dat, 1);
}
#ifdef DEBUGGING
- /* Yes this does cause a memory leak in debugging Perls */
- if (!av_store(RExC_paren_name_list, RExC_npar, SvREFCNT_inc(svname)))
+ /* Yes this does cause a memory leak in debugging Perls
+ * */
+ if (!av_store(RExC_paren_name_list,
+ RExC_npar, SvREFCNT_inc(svname)))
SvREFCNT_dec_NN(svname);
#endif
case '|': /* (?|...) */
/* branch reset, behave like a (?:...) except that
buffers in alternations share the same numbers */
- paren = ':';
+ paren = ':';
after_freeze = freeze_paren = RExC_npar;
break;
case ':': /* (?:...) */
if (!(RExC_parse[0] >= '1' && RExC_parse[0] <= '9')) {
RExC_parse--; /* rewind to let it be handled later */
goto parse_flags;
- }
+ }
/*FALLTHROUGH */
case '1': case '2': case '3': case '4': /* (?1) */
case '5': case '6': case '7': case '8': case '9':
RExC_parse++;
while (isDIGIT(*RExC_parse))
RExC_parse++;
- if (*RExC_parse!=')')
+ if (*RExC_parse!=')')
vFAIL("Expecting close bracket");
gen_recurse_regop:
ARG2L_SET( ret, RExC_recurse_count++);
RExC_emit++;
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
- "Recurse #%"UVuf" to %"IVdf"\n", (UV)ARG(ret), (IV)ARG2L(ret)));
+ "Recurse #%"UVuf" to %"IVdf"\n",
+ (UV)ARG(ret), (IV)ARG2L(ret)));
} else {
RExC_size++;
}
ret = reg_node(pRExC_state, LOGICAL);
if (!SIZE_ONLY)
ret->flags = 1;
-
+
tail = reg(pRExC_state, 1, &flag, depth+1);
if (flag & RESTART_UTF8) {
*flagp = RESTART_UTF8;
SV *sv_dat;
RExC_parse++;
sv_dat = reg_scan_name(pRExC_state,
- SIZE_ONLY ? REG_RSN_RETURN_NULL : REG_RSN_RETURN_DATA);
+ SIZE_ONLY
+ ? REG_RSN_RETURN_NULL
+ : REG_RSN_RETURN_DATA);
parno = sv_dat ? *((I32 *)SvPVX(sv_dat)) : 0;
}
- ret = reganode(pRExC_state,INSUBP,parno);
+ ret = reganode(pRExC_state,INSUBP,parno);
goto insert_if_check_paren;
}
else if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
FAIL2("panic: regbranch returned NULL, flags=%#"UVxf"",
(UV) flags);
} else
- REGTAIL(pRExC_state, br, reganode(pRExC_state, LONGJMP, 0));
+ REGTAIL(pRExC_state, br, reganode(pRExC_state,
+ LONGJMP, 0));
c = *nextchar(pRExC_state);
if (flags&HASWIDTH)
*flagp |= HASWIDTH;
if (c == '|') {
- if (is_define)
+ if (is_define)
vFAIL("(?(DEFINE)....) does not allow branches");
- lastbr = reganode(pRExC_state, IFTHEN, 0); /* Fake one for optimizer. */
+
+ /* Fake one for optimizer. */
+ lastbr = reganode(pRExC_state, IFTHEN, 0);
+
if (!regbranch(pRExC_state, &flags, 1,depth+1)) {
if (flags & RESTART_UTF8) {
*flagp = RESTART_UTF8;
capturing_parens:
parno = RExC_npar;
RExC_npar++;
-
+
ret = reganode(pRExC_state, OPEN, parno);
if (!SIZE_ONLY ){
- if (!RExC_nestroot)
+ if (!RExC_nestroot)
RExC_nestroot = parno;
if (RExC_seen & REG_SEEN_RECURSE
&& !RExC_open_parens[parno-1])
{
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
- "Setting open paren #%"IVdf" to %d\n",
+ "Setting open paren #%"IVdf" to %d\n",
(IV)parno, REG_NODE_NUM(ret)));
RExC_open_parens[parno-1]= ret;
}
}
else /* ! paren */
ret = NULL;
-
+
parse_rest:
/* Pick up the branches, linking them together. */
parse_start = RExC_parse; /* MJD */
while (*RExC_parse == '|') {
if (!SIZE_ONLY && RExC_extralen) {
ender = reganode(pRExC_state, LONGJMP,0);
- REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender); /* Append to the previous. */
+
+ /* Append to the previous. */
+ REGTAIL(pRExC_state, NEXTOPER(NEXTOPER(lastbr)), ender);
}
if (SIZE_ONLY)
RExC_extralen += 2; /* Account for LONGJMP. */
if (freeze_paren) {
if (RExC_npar > after_freeze)
after_freeze = RExC_npar;
- RExC_npar = freeze_paren;
+ RExC_npar = freeze_paren;
}
br = regbranch(pRExC_state, &flags, 0, depth+1);
ender = reganode(pRExC_state, CLOSE, parno);
if (!SIZE_ONLY && RExC_seen & REG_SEEN_RECURSE) {
DEBUG_OPTIMISE_MORE_r(PerlIO_printf(Perl_debug_log,
- "Setting close paren #%"IVdf" to %d\n",
+ "Setting close paren #%"IVdf" to %d\n",
(IV)parno, REG_NODE_NUM(ender)));
RExC_close_parens[parno-1]= ender;
- if (RExC_nestroot == parno)
+ if (RExC_nestroot == parno)
RExC_nestroot = 0;
- }
+ }
Set_Node_Offset(ender,RExC_parse+1); /* MJD */
Set_Node_Length(ender,1); /* MJD */
break;
const U8 op = PL_regkind[OP(br)];
if (op == BRANCH) {
REGTAIL_STUDY(pRExC_state, NEXTOPER(br), ender);
- if (OP(NEXTOPER(br)) != NOTHING || regnext(NEXTOPER(br)) != ender)
+ if ( OP(NEXTOPER(br)) != NOTHING
+ || regnext(NEXTOPER(br)) != ender)
is_nothing= 0;
}
else if (op == BRANCHJ) {
REGTAIL_STUDY(pRExC_state, NEXTOPER(NEXTOPER(br)), ender);
/* for now we always disable this optimisation * /
- if (OP(NEXTOPER(NEXTOPER(br))) != NOTHING || regnext(NEXTOPER(NEXTOPER(br))) != ender)
+ if ( OP(NEXTOPER(NEXTOPER(br))) != NOTHING
+ || regnext(NEXTOPER(NEXTOPER(br))) != ender)
*/
is_nothing= 0;
}
SAVEFREESV(RExC_rx_sv); /* in case of fatal warnings */
ckWARN2reg(RExC_parse,
"%"UTF8f" matches null string many times",
- UTF8fARG(UTF, (RExC_parse >= origparse ? RExC_parse - origparse : 0),
+ UTF8fARG(UTF, (RExC_parse >= origparse
+ ? RExC_parse - origparse
+ : 0),
origparse));
(void)ReREFCNT_inc(RExC_rx_sv);
}
}
STATIC bool
-S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, regnode** node_p, UV *valuep, I32 *flagp, U32 depth, bool in_char_class,
- const bool strict /* Apply stricter parsing rules? */
+S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, regnode** node_p,
+ UV *valuep, I32 *flagp, U32 depth, bool in_char_class,
+ const bool strict /* Apply stricter parsing rules? */
)
{
-
+
/* This is expected to be called by a parser routine that has recognized '\N'
and needs to handle the rest. RExC_parse is expected to point at the first
char following the N at the time of the call. On successful return,
more than one character */
GET_RE_DEBUG_FLAGS_DECL;
-
+
PERL_ARGS_ASSERT_GROK_BSLASH_N;
GET_RE_DEBUG_FLAGS;
if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */
|| ! (endbrace == RExC_parse /* nothing between the {} */
- || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked below */
- && strnEQ(RExC_parse, "U+", 2)))) /* for a better error msg) */
+ || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked below
+ */
+ && strnEQ(RExC_parse, "U+", 2)))) /* for a better error msg)
+ */
{
if (endbrace) RExC_parse = endbrace; /* position msg's '<--HERE' */
vFAIL("\\N{NAME} must be resolved by the lexer");
}
FAIL2("panic: reg returned NULL to grok_bslash_N, flags=%#"UVxf"",
(UV) flags);
- }
+ }
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE|POSTPONED);
RExC_parse = endbrace;
}
PERL_STATIC_INLINE void
-S_alloc_maybe_populate_EXACT(pTHX_ RExC_state_t *pRExC_state, regnode *node, I32* flagp, STRLEN len, UV code_point)
+S_alloc_maybe_populate_EXACT(pTHX_ RExC_state_t *pRExC_state,
+ regnode *node, I32* flagp, STRLEN len, UV code_point)
{
/* This knows the details about sizing an EXACTish node, setting flags for
* it (by setting <*flagp>, and potentially populating it with a single
by the other.
Returns NULL, setting *flagp to TRYAGAIN if reg() returns NULL with
- TRYAGAIN.
+ TRYAGAIN.
Returns NULL, setting *flagp to RESTART_UTF8 if the sizing scan needs to be
restarted.
Otherwise does not return NULL.
*flagp = RESTART_UTF8;
return NULL;
}
- FAIL2("panic: reg returned NULL to regatom, flags=%#"UVxf"", (UV) flags);
+ FAIL2("panic: reg returned NULL to regatom, flags=%#"UVxf"",
+ (UV) flags);
}
*flagp |= flags&(HASWIDTH|SPSTART|SIMPLE|POSTPONED);
break;
*flagp |= HASWIDTH|SIMPLE;
/* FALL THROUGH */
- finish_meta_pat:
+ finish_meta_pat:
nextchar(pRExC_state);
Set_Node_Length(ret, 2); /* MJD */
- break;
+ break;
case 'p':
case 'P':
{
nextchar(pRExC_state);
}
break;
- case 'N':
+ case 'N':
/* Handle \N and \N{NAME} with multiple code points here and not
* below because it can be multicharacter. join_exact() will join
* them up later on. Also this makes sure that things like
break;
case 'k': /* Handle \k<NAME> and \k'NAME' */
parse_named_seq:
- {
- char ch= RExC_parse[1];
+ {
+ char ch= RExC_parse[1];
if (ch != '<' && ch != '\'' && ch != '{') {
RExC_parse++;
/* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */
}
break;
}
- case 'g':
+ case 'g':
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
{
}
if (hasbrace && !isDIGIT(*RExC_parse)) {
if (isrel) RExC_parse--;
- RExC_parse -= 2;
+ RExC_parse -= 2;
goto parse_named_seq;
}
while (isDIGIT(*RExC_parse))
RExC_parse++;
if (hasbrace) {
- if (*RExC_parse != '}')
+ if (*RExC_parse != '}')
vFAIL("Unterminated \\g{...} pattern");
RExC_parse++;
- }
+ }
if (!SIZE_ONLY) {
if (num > (I32)RExC_rx->nparens)
vFAIL("Reference to nonexistent group");
case 's': case 'S': /* space class */
case 'v': case 'V': /* VERTWS */
case 'w': case 'W': /* word class */
- case 'X': /* eXtended Unicode "combining character sequence" */
+ case 'X': /* eXtended Unicode "combining
+ character sequence" */
case 'z': case 'Z': /* End of line/string assertion */
--p;
goto loopdone;
goto loopdone;
}
- if (! FOLD) {
+ if (! FOLD) { /* The simple case, just append the literal */
if (UTF) {
const STRLEN unilen = reguni(pRExC_state, ender, s);
if (unilen > 0) {
|| (node_type == EXACTFU
&& ender == LATIN_SMALL_LETTER_SHARP_S)))
{
+ /* Here, are folding and are not UTF-8 encoded; therefore
+ * the character must be in the range 0-255. */
if (IS_IN_SOME_FOLD_L1(ender)) {
maybe_exact = FALSE;
|| ender == LATIN_SMALL_LETTER_SHARP_S
|| (len > 0
&& isARG2_lower_or_UPPER_ARG1('s', ender)
- && isARG2_lower_or_UPPER_ARG1('s', *(s-1)))))
+ && isARG2_lower_or_UPPER_ARG1('s',
+ *(s-1)))))
{
maybe_exactfu = FALSE;
}
}
+
+ /* Even when folding, we store just the input character, as
+ * we have an array that finds its fold quickly */
*(s++) = (char) ender;
}
- else { /* UTF */
+ else { /* FOLD and UTF */
+ /* Unlike the non-fold case, we do actually have to
+ * calculate the results here in pass 1. This is for two
+ * reasons, the folded length may be longer than the
+ * unfolded, and we have to calculate how many EXACTish
+ * nodes it will take; and we may run out of room in a node
+ * in the middle of a potential multi-char fold, and have
+ * to back off accordingly. */
/* Prime the casefolded buffer. Locale rules, which apply
* only to code points < 256, aren't known until execution,
foldlen = 2;
}
}
- else {
+ else { /* ender >= 256 */
UV folded = _to_uni_fold_flags(
ender,
(U8 *) s,
invlist_iterfinish(*invlist_ptr);
/* Done with loop; remove any code points that are in the bitmap from
- * *invlist_ptr; similarly for code points above latin1 if we have a flag
- * to match all of them anyways */
+ * *invlist_ptr; similarly for code points above latin1 if we have a
+ * flag to match all of them anyways */
if (change_invlist) {
_invlist_subtract(*invlist_ptr, PL_Latin1, invlist_ptr);
}
}
STATIC regnode *
-S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, I32 *flagp, U32 depth,
- char * const oregcomp_parse)
+S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist,
+ I32 *flagp, U32 depth,
+ char * const oregcomp_parse)
{
/* Handle the (?[...]) construct to do set operations */
packWARN(WARN_EXPERIMENTAL__REGEX_SETS),
"The regex_sets feature is experimental" REPORT_LOCATION,
UTF8fARG(UTF, (RExC_parse - RExC_precomp), RExC_precomp),
- UTF8fARG(UTF, RExC_end - RExC_start - (RExC_parse - RExC_precomp), RExC_precomp + (RExC_parse - RExC_precomp)));
+ UTF8fARG(UTF,
+ RExC_end - RExC_start - (RExC_parse - RExC_precomp),
+ RExC_precomp + (RExC_parse - RExC_precomp)));
while (RExC_parse < RExC_end) {
SV* current = NULL;
/* The names of properties whose definitions are not known at compile time are
* stored in this SV, after a constant heading. So if the length has been
* changed since initialization, then there is a run-time definition. */
-#define HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION (SvCUR(listsv) != initial_listsv_len)
+#define HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION \
+ (SvCUR(listsv) != initial_listsv_len)
STATIC regnode *
S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
* like locale, folding, utf8ness of the target string */
SV* cp_list = NULL;
- /* Inversion list of code points this node matches regardless of things
- * like locale, utf8ness of the target string. But code points on this
- * list need to be checked for things that fold to/from them under /i */
+ /* Like cp_list, but code points on this list need to be checked for things
+ * that fold to/from them under /i */
SV* cp_foldable_list = NULL;
#ifdef EBCDIC
case 'H': namedclass = ANYOF_NHORIZWS; break;
case 'N': /* Handle \N{NAME} in class */
{
- /* We only pay attention to the first char of
+ /* We only pay attention to the first char of
multichar strings being returned. I kinda wonder
if this makes sense as it does change the behaviour
from earlier versions, OTOH that behaviour was broken
&& (! isASCII(j) || ! ASCII_FOLD_RESTRICTED))
{
/* Certain Latin1 characters have matches outside
- * Latin1. To get here, <j> is one of those
- * characters. None of these matches is valid for
- * ASCII characters under /aa, which is why the
- * 'if' just above excludes those. These matches
- * only happen when the target string is utf8. The
- * code below adds the single fold closures for <j>
- * to the inversion list. */
+ * Latin1. To get here, <j> is one of those
+ * characters. None of these matches is valid for
+ * ASCII characters under /aa, which is why the 'if'
+ * just above excludes those. These matches only
+ * happen when the target string is utf8. The code
+ * below adds the single fold closures for <j> to the
+ * inversion list. */
+
switch (j) {
case 'k':
case 'K':
break;
default:
/* Use deprecated warning to increase the
- * chances of this being output */
+ * chances of this being output */
ckWARN2reg_d(RExC_parse, "Perl folding rules are not up-to-date for 0x%"UVXf"; please use the perlbug utility to report;", j);
break;
}
? FOLD_FLAGS_NOMIX_ASCII
: 0));
- /* Single character fold of above Latin1. Add everything
- * in its fold closure to the list that this node should
- * match. The fold closures data structure is a hash with
- * the keys being the UTF-8 of every character that is
- * folded to, like 'k', and the values each an array of all
- * code points that fold to its key. e.g. [ 'k', 'K',
- * KELVIN_SIGN ]. Multi-character folds are not included
- * */
+ /* Single character fold of above Latin1. Add everything in
+ * its fold closure to the list that this node should match.
+ * The fold closures data structure is a hash with the keys
+ * being the UTF-8 of every character that is folded to, like
+ * 'k', and the values each an array of all code points that
+ * fold to its key. e.g. [ 'k', 'K', KELVIN_SIGN ].
+ * Multi-character folds are not included */
if ((listp = hv_fetch(PL_utf8_foldclosures,
- (char *) foldbuf, foldlen, FALSE)))
+ (char *) foldbuf, foldlen, FALSE)))
{
AV* list = (AV*) *listp;
IV k;
* are using above-Unicode code points indicates they should know
* the issues involved */
if (warn_super) {
- warn_super = ! (invert ^ (invlist_highest(cp_list) > PERL_UNICODE_MAX));
+ warn_super = ! (invert
+ ^ (invlist_highest(cp_list) > PERL_UNICODE_MAX));
}
_invlist_union(properties, cp_list, &cp_list);
&& (start < 256 || UTF))
{
/* Here, the list contains a single code point. Can optimize
- * into an EXACT node */
+ * into an EXACTish node */
value = start;
FILL_ADVANCE_NODE(ptr, op);
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n",
- "reg_node", __LINE__,
+ MJD_OFFSET_DEBUG(
+ ("%s:%d: (op %s) %s %"UVuf" (len %"UVuf") (max %"UVuf").\n",
+ "reg_node", __LINE__,
PL_reg_name[op],
- (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0]
+ (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
(UV)(RExC_emit - RExC_emit_start),
(UV)(RExC_parse - RExC_start),
- (UV)RExC_offsets[0]));
+ (UV)RExC_offsets[0]));
Set_Node_Offset(RExC_emit, RExC_parse + (op == END));
}
#endif
if (SIZE_ONLY) {
SIZE_ALIGN(RExC_size);
RExC_size += 2;
- /*
+ /*
We can't do this:
-
- assert(2==regarglen[op]+1);
+
+ assert(2==regarglen[op]+1);
Anything larger than this has to allocate the extra amount.
If we changed this to be:
-
+
RExC_size += (1 + regarglen[op]);
-
+
then it wouldn't matter. Its not clear what side effect
might come from that so its not done so far.
-- dmq
FILL_ADVANCE_NODE_ARG(ptr, op, arg);
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
+ MJD_OFFSET_DEBUG(
+ ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
"reganode",
__LINE__,
PL_reg_name[op],
- (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ?
+ (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ?
"Overwriting end of array!\n" : "OK",
(UV)(RExC_emit - RExC_emit_start),
(UV)(RExC_parse - RExC_start),
- (UV)RExC_offsets[0]));
+ (UV)RExC_offsets[0]));
Set_Cur_Node_Offset;
}
-#endif
+#endif
RExC_emit = ptr;
return(ret);
}
StructCopy(--src, --dst, regnode);
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD 20010112 */
- MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
+ MJD_OFFSET_DEBUG(
+ ("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
"reg_insert",
__LINE__,
PL_reg_name[op],
- (UV)(dst - RExC_emit_start) > RExC_offsets[0]
+ (UV)(dst - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
(UV)(src - RExC_emit_start),
(UV)(dst - RExC_emit_start),
- (UV)RExC_offsets[0]));
+ (UV)RExC_offsets[0]));
Set_Node_Offset_To_R(dst-RExC_emit_start, Node_Offset(src));
Set_Node_Length_To_R(dst-RExC_emit_start, Node_Length(src));
}
#endif
}
-
+
place = opnd; /* Op node, where operand used to be. */
#ifdef RE_TRACK_PATTERN_OFFSETS
if (RExC_offsets) { /* MJD */
- MJD_OFFSET_DEBUG(("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
+ MJD_OFFSET_DEBUG(
+ ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
"reginsert",
__LINE__,
PL_reg_name[op],
- (UV)(place - RExC_emit_start) > RExC_offsets[0]
+ (UV)(place - RExC_emit_start) > RExC_offsets[0]
? "Overwriting end of array!\n" : "OK",
(UV)(place - RExC_emit_start),
(UV)(RExC_parse - RExC_start),
Set_Node_Offset(place, RExC_parse);
Set_Node_Length(place, 1);
}
-#endif
+#endif
src = NEXTOPER(place);
FILL_ADVANCE_NODE(place, op);
Zero(src, offset, regnode);
*/
/* TODO: All three parms should be const */
STATIC void
-S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
+S_regtail(pTHX_ RExC_state_t *pRExC_state, regnode *p,
+ const regnode *val,U32 depth)
{
dVAR;
regnode *scan;
- Look for optimizable sequences at the same time.
- currently only looks for EXACT chains.
-This is experimental code. The idea is to use this routine to perform
+This is experimental code. The idea is to use this routine to perform
in place optimizations on branches and groups as they are constructed,
with the long term intention of removing optimization from study_chunk so
that it is purely analytical.
/* TODO: All four parms should be const */
STATIC U8
-S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,U32 depth)
+S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p,
+ const regnode *val,U32 depth)
{
dVAR;
regnode *scan;
#ifdef EXPERIMENTAL_INPLACESCAN
if (PL_regkind[OP(scan)] == EXACT) {
bool has_exactf_sharp_s; /* Unexamined in this routine */
- if (join_exact(pRExC_state,scan,&min, &has_exactf_sharp_s, 1,val,depth+1))
+ if (join_exact(pRExC_state, scan, &min,
+ &has_exactf_sharp_s, 1, val, depth+1))
return EXACT;
}
#endif
SV * const mysv_val=sv_newmortal();
DEBUG_PARSE_MSG("");
regprop(RExC_rx, mysv_val, val);
- PerlIO_printf(Perl_debug_log, "~ attach to %s (%"IVdf") offset to %"IVdf"\n",
+ PerlIO_printf(Perl_debug_log,
+ "~ attach to %s (%"IVdf") offset to %"IVdf"\n",
SvPV_nolen_const(mysv_val),
(IV)REG_NODE_NUM(val),
(IV)(val - scan)
}
}
-static void
+static void
S_regdump_extflags(pTHX_ const char *lead, const U32 flags)
{
int bit;
if ((1<<bit) & RXf_PMf_CHARSET) { /* Output separately, below */
continue;
}
- if (!set++ && lead)
+ if (!set++ && lead)
PerlIO_printf(Perl_debug_log, "%s",lead);
PerlIO_printf(Perl_debug_log, "%s ",PL_reg_extflags_name[bit]);
- }
- }
+ }
+ }
if ((cs = get_regex_charset(flags)) != REGEX_DEPENDS_CHARSET) {
if (!set++ && lead) {
PerlIO_printf(Perl_debug_log, "%s",lead);
}
}
if (lead) {
- if (set)
+ if (set)
PerlIO_printf(Perl_debug_log, "\n");
- else
+ else
PerlIO_printf(Perl_debug_log, "%s[none-set]\n",lead);
- }
-}
+ }
+}
#endif
void
/* Header fields of interest. */
if (r->anchored_substr) {
- RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr),
+ RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->anchored_substr),
RE_SV_DUMPLEN(r->anchored_substr), 30);
PerlIO_printf(Perl_debug_log,
"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_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->anchored_utf8),
RE_SV_DUMPLEN(r->anchored_utf8), 30);
PerlIO_printf(Perl_debug_log,
"anchored utf8 %s%s at %"IVdf" ",
s, RE_SV_TAIL(r->anchored_utf8),
(IV)r->anchored_offset);
- }
+ }
if (r->float_substr) {
- RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr),
+ RE_PV_QUOTED_DECL(s, 0, dsv, SvPVX_const(r->float_substr),
RE_SV_DUMPLEN(r->float_substr), 30);
PerlIO_printf(Perl_debug_log,
"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_PV_QUOTED_DECL(s, 1, dsv, SvPVX_const(r->float_utf8),
RE_SV_DUMPLEN(r->float_utf8), 30);
PerlIO_printf(Perl_debug_log,
"floating utf8 %s%s at %"IVdf"..%"UVuf" ",
};
RXi_GET_DECL(prog,progi);
GET_RE_DEBUG_FLAGS_DECL;
-
+
PERL_ARGS_ASSERT_REGPROP;
sv_setpvs(sv, "");
if (OP(o) > REGNODE_MAX) /* regnode.type is unsigned */
/* It would be nice to FAIL() here, but this may be called from
regexec.c, and it would be hard to supply pRExC_state. */
- Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(o), (int)REGNODE_MAX);
+ Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d",
+ (int)OP(o), (int)REGNODE_MAX);
sv_catpv(sv, PL_reg_name[OP(o)]); /* Take off const! */
k = PL_regkind[OP(o)];
if (k == EXACT) {
sv_catpvs(sv, " ");
- /* Using is_utf8_string() (via PERL_PV_UNI_DETECT)
- * is a crude hack but it may be the best for now since
- * we have no flag "this EXACTish node was UTF-8"
+ /* Using is_utf8_string() (via PERL_PV_UNI_DETECT)
+ * is a crude hack but it may be the best for now since
+ * we have no flag "this EXACTish node was UTF-8"
* --jhi */
pv_pretty(sv, STRING(o), STR_LEN(o), 60, PL_colors[0], PL_colors[1],
PERL_PV_ESCAPE_UNI_DETECT |
NULL;
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",PL_reg_name[o->flags]);
DEBUG_TRIE_COMPILE_r(
- Perl_sv_catpvf(aTHX_ sv,
- "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">",
- (UV)trie->startstate,
- (IV)trie->statecount-1, /* -1 because of the unused 0 element */
- (UV)trie->wordcount,
- (UV)trie->minlen,
- (UV)trie->maxlen,
- (UV)TRIE_CHARCOUNT(trie),
- (UV)trie->uniquecharcount
- )
+ Perl_sv_catpvf(aTHX_ sv,
+ "<S:%"UVuf"/%"IVdf" W:%"UVuf" L:%"UVuf"/%"UVuf" C:%"UVuf"/%"UVuf">",
+ (UV)trie->startstate,
+ (IV)trie->statecount-1, /* -1 because of the unused 0 element */
+ (UV)trie->wordcount,
+ (UV)trie->minlen,
+ (UV)trie->maxlen,
+ (UV)TRIE_CHARCOUNT(trie),
+ (UV)trie->uniquecharcount
+ )
);
if ( IS_ANYOF_TRIE(op) || trie->bitmap ) {
sv_catpvs(sv, "[");
? ANYOF_BITMAP(o)
: TRIE_BITMAP(trie));
sv_catpvs(sv, "]");
- }
-
+ }
+
} else if (k == CURLY) {
if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX)
Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */
}
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 */
if ( RXp_PAREN_NAMES(prog) ) {
if ( k != REF || (OP(o) < NREF)) {
SV **name= av_fetch(list, ARG(o), 0 );
if (name)
Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
- }
+ }
else {
AV *list= MUTABLE_AV(progi->data->data[ progi->name_list_idx ]);
SV *sv_dat= MUTABLE_SV(progi->data->data[ ARG( o ) ]);
Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name));
}
}
- }
- } else if (k == GOSUB)
- Perl_sv_catpvf(aTHX_ sv, "%d[%+d]", (int)ARG(o),(int)ARG2L(o)); /* Paren and offset */
+ }
+ } else if (k == GOSUB)
+ /* Paren and offset */
+ Perl_sv_catpvf(aTHX_ sv, "%d[%+d]", (int)ARG(o),(int)ARG2L(o));
else if (k == VERB) {
- if (!o->flags)
- Perl_sv_catpvf(aTHX_ sv, ":%"SVf,
+ if (!o->flags)
+ Perl_sv_catpvf(aTHX_ sv, ":%"SVf,
SVfARG((MUTABLE_SV(progi->data->data[ ARG( o ) ]))));
} else if (k == LOGICAL)
- Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */
+ /* 2: embedded, otherwise 1 */
+ Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);
else if (k == ANYOF) {
const U8 flags = ANYOF_FLAGS(o);
int do_sep = 0;
/* output what the standard cp 0-255 bitmap matches */
do_sep = put_latin1_charclass_innards(sv, ANYOF_BITMAP(o));
-
+
/* output any special charclass tests (used entirely under use
* locale) * */
if (ANYOF_POSIXL_TEST_ANY_SET(o)) {
}
}
}
-
+
if (flags & (ANYOF_ABOVE_LATIN1_ALL|ANYOF_ABOVE_LATIN1_ALL)
|| ANYOF_NONBITMAP(o))
{
/*make sure the invert info is in each */
sv_catpvs(sv, "^");
}
-
- if (flags & ANYOF_NON_UTF8_NON_ASCII_ALL) {
- sv_catpvs(sv, "{non-utf8-latin1-all}");
- }
- /* output information about the unicode matching */
- if (flags & ANYOF_ABOVE_LATIN1_ALL)
- sv_catpvs(sv, "{unicode_all}");
- else if (ANYOF_NONBITMAP(o)) {
- SV *lv; /* Set if there is something outside the bit map. */
- bool byte_output = FALSE; /* If something in the bitmap has been
- output */
-
- /* Get the stuff that wasn't in the bitmap */
- (void) regclass_swash(prog, o, FALSE, &lv, NULL);
- if (lv && lv != &PL_sv_undef) {
- char *s = savesvpv(lv);
- char * const origs = s;
+ if (flags & ANYOF_NON_UTF8_NON_ASCII_ALL) {
+ sv_catpvs(sv, "{non-utf8-latin1-all}");
+ }
- while (*s && *s != '\n')
- s++;
+ /* output information about the unicode matching */
+ if (flags & ANYOF_ABOVE_LATIN1_ALL)
+ sv_catpvs(sv, "{unicode_all}");
+ else if (ANYOF_NONBITMAP(o)) {
+ SV *lv; /* Set if there is something outside the bit map. */
+ bool byte_output = FALSE; /* If something in the bitmap has
+ been output */
+
+ /* Get the stuff that wasn't in the bitmap */
+ (void) regclass_swash(prog, o, FALSE, &lv, NULL);
+ if (lv && lv != &PL_sv_undef) {
+ char *s = savesvpv(lv);
+ char * const origs = s;
+
+ while (*s && *s != '\n')
+ s++;
- if (*s == '\n') {
- const char * const t = ++s;
+ if (*s == '\n') {
+ const char * const t = ++s;
- if (flags & ANYOF_NONBITMAP_NON_UTF8) {
- sv_catpvs(sv, "{outside bitmap}");
- }
- else {
- sv_catpvs(sv, "{utf8}");
- }
+ if (flags & ANYOF_NONBITMAP_NON_UTF8) {
+ sv_catpvs(sv, "{outside bitmap}");
+ }
+ else {
+ sv_catpvs(sv, "{utf8}");
+ }
- if (byte_output) {
- sv_catpvs(sv, " ");
- }
+ if (byte_output) {
+ sv_catpvs(sv, " ");
+ }
- while (*s) {
- if (*s == '\n') {
+ while (*s) {
+ if (*s == '\n') {
- /* Truncate very long output */
- if (s - origs > 256) {
- Perl_sv_catpvf(aTHX_ sv,
- "%.*s...",
- (int) (s - origs - 1),
- t);
- goto out_dump;
+ /* Truncate very long output */
+ if (s - origs > 256) {
+ Perl_sv_catpvf(aTHX_ sv,
+ "%.*s...",
+ (int) (s - origs - 1),
+ t);
+ goto out_dump;
+ }
+ *s = ' ';
}
- *s = ' ';
- }
- else if (*s == '\t') {
- *s = '-';
+ else if (*s == '\t') {
+ *s = '-';
+ }
+ s++;
}
- s++;
- }
- if (s[-1] == ' ')
- s[-1] = 0;
+ if (s[-1] == ' ')
+ s[-1] = 0;
- sv_catpv(sv, t);
- }
+ sv_catpv(sv, t);
+ }
- out_dump:
+ out_dump:
- Safefree(origs);
- SvREFCNT_dec_NN(lv);
- }
- }
+ Safefree(origs);
+ SvREFCNT_dec_NN(lv);
+ }
+ }
}
Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
return prog->check_substr ? prog->check_substr : prog->check_utf8;
}
-/*
- pregfree()
-
- handles refcounting and freeing the perl core regexp structure. When
- it is necessary to actually free the structure the first thing it
+/*
+ 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
- the regexp, allowing the handling of the void *pprivate; member
- first. (This routine is not overridable by extensions, which is why
+ 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 and regdupe_internal if you change anything here.
+
+ See regdupe and regdupe_internal if you change anything here.
*/
#ifndef PERL_IN_XSUB_RE
void
CALLREGFREE_PVT(rx); /* free the private data */
SvREFCNT_dec(RXp_PAREN_NAMES(r));
Safefree(r->xpv_len_u.xpvlenu_pv);
- }
+ }
if (r->substrs) {
SvREFCNT_dec(r->anchored_substr);
SvREFCNT_dec(r->anchored_utf8);
}
/* reg_temp_copy()
-
+
This is a hacky workaround to the structural issue of match results
being stored in the regexp structure which is in turn stored in
PL_curpm/PL_reg_curpm. The problem is that due to qr// the pattern
could be PL_curpm in multiple contexts, and could require multiple
result sets being associated with the pattern simultaneously, such
as when doing a recursive match with (??{$qr})
-
- The solution is to make a lightweight copy of the regexp structure
+
+ The solution is to make a lightweight copy of the regexp structure
when a qr// is returned from the code executed by (??{$qr}) this
lightweight copy doesn't actually own any of its data except for
- the starp/end and the actual regexp structure itself.
-
-*/
-
-
+ the starp/end and the actual regexp structure itself.
+
+*/
+
+
REGEXP *
Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx)
{
sv_force_normal(sv) is called. */
SvFAKE_on(ret_x);
ret = ReANY(ret_x);
-
+
SvFLAGS(ret_x) |= SvUTF8(rx);
/* We share the same string buffer as the original regexp, on which we
hold a reference count, incremented when mother_re is set below.
#endif
ret->mother_re = ReREFCNT_inc(r->mother_re ? r->mother_re : rx);
SvREFCNT_inc_void(ret->qr_anoncv);
-
+
return ret_x;
}
#endif
-/* regfree_internal()
+/* 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 perl doesn't
+ know about, however of course we have to handle the
+ regexp_internal structure when no extension is in use.
- 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 perl doesn't
- 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.
+ Note this is called before freeing anything in the regexp
+ structure.
*/
-
+
void
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);
- PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n",
+ PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n",
PL_colors[4],PL_colors[5],s);
}
});
case 'l':
case 'L':
break;
- case 'T':
+ case 'T':
{ /* Aho Corasick add-on structure for a trie node.
Used in stclass optimization only */
U32 refcount;
}
break;
default:
- Perl_croak(aTHX_ "panic: regfree data code '%c'", ri->data->what[n]);
+ Perl_croak(aTHX_ "panic: regfree data code '%c'",
+ ri->data->what[n]);
}
}
Safefree(ri->data->what);
#define hv_dup_inc(s,t) MUTABLE_HV(sv_dup_inc((const SV *)s,t))
#define SAVEPVN(p,n) ((p) ? savepvn(p,n) : NULL)
-/*
- re_dup - duplicate a regexp.
-
+/*
+ re_dup - duplicate a regexp.
+
This routine is expected to clone a given regexp structure. It is only
compiled under USE_ITHREADS.
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.
+ See pregfree() and regfree_internal() if you change anything here.
*/
#if defined(USE_ITHREADS)
#ifndef PERL_IN_XSUB_RE
I32 npar;
const struct regexp *r = ReANY(sstr);
struct regexp *ret = ReANY(dstr);
-
+
PERL_ARGS_ASSERT_RE_DUP_GUTS;
npar = r->nparens+1;
/*
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
+ 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.
*/
RXi_GET_DECL(r,ri);
PERL_ARGS_ASSERT_REGDUPE_INTERNAL;
-
+
len = ProgLen(ri);
-
- Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode), char, regexp_internal);
+
+ Newxc(reti, sizeof(regexp_internal) + len*sizeof(regnode),
+ char, regexp_internal);
Copy(ri->program, reti->program, len+1, regnode);
reti->num_code_blocks = ri->num_code_blocks;
d->data[i] = ri->data->data[i];
break;
default:
- Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'", ri->data->what[i]);
+ Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'",
+ ri->data->what[i]);
}
}
return(NULL);
if (OP(p) > REGNODE_MAX) { /* regnode.type is unsigned */
- Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(p), (int)REGNODE_MAX);
+ Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d",
+ (int)OP(p), (int)REGNODE_MAX);
}
offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p));
U32 i;
for (i = 1; i <= RX_NPARENS(rx); i++) {
char digits[TYPE_CHARS(long)];
- const STRLEN len = my_snprintf(digits, sizeof(digits), "%lu", (long)i);
+ const STRLEN len = my_snprintf(digits, sizeof(digits),
+ "%lu", (long)i);
GV *const *const gvp
= (GV**)hv_fetch(PL_defstash, digits, len, 0);
}
#define CLEAR_OPTSTART \
- if (optstart) STMT_START { \
- DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log, " (%"IVdf" nodes)\n", (IV)(node - optstart))); \
- optstart=NULL; \
+ if (optstart) STMT_START { \
+ DEBUG_OPTIMISE_r(PerlIO_printf(Perl_debug_log, \
+ " (%"IVdf" nodes)\n", (IV)(node - optstart))); \
+ optstart=NULL; \
} STMT_END
-#define DUMPUNTIL(b,e) CLEAR_OPTSTART; node=dumpuntil(r,start,(b),(e),last,sv,indent+1,depth+1);
+#define DUMPUNTIL(b,e) \
+ CLEAR_OPTSTART; \
+ node=dumpuntil(r,start,(b),(e),last,sv,indent+1,depth+1);
STATIC const regnode *
S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
- const regnode *last, const regnode *plast,
+ const regnode *last, const regnode *plast,
SV* sv, I32 indent, U32 depth)
{
dVAR;
U8 op = PSEUDO; /* Arbitrary non-END op. */
const regnode *next;
const regnode *optstart= NULL;
-
+
RXi_GET_DECL(r,ri);
GET_RE_DEBUG_FLAGS_DECL;
PerlIO_printf(Perl_debug_log, "--- %d : %d - %d - %d\n",indent,node-start,
last ? last-start : 0,plast ? plast-start : 0);
#endif
-
- if (plast && plast < last)
+
+ if (plast && plast < last)
last= plast;
while (PL_regkind[op] != END && (!last || node < last)) {
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 (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 )
+ else if (PL_regkind[(U8)op] == BRANCH
+ && PL_regkind[OP(next)] != BRANCH )
PerlIO_printf(Perl_debug_log, " (FAIL)");
- else
+ else
PerlIO_printf(Perl_debug_log, " (%"IVdf")", (IV)(next - start));
- (void)PerlIO_putc(Perl_debug_log, '\n');
+ (void)PerlIO_putc(Perl_debug_log, '\n');
}
-
+
after_print:
if (PL_regkind[(U8)op] == BRANCHJ) {
assert(next);
const reg_trie_data * const trie =
(reg_trie_data*)ri->data->data[op<AHOCORASICK ? n : ac->trie];
#ifdef DEBUGGING
- AV *const trie_words = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
+ AV *const trie_words
+ = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]);
#endif
const regnode *nextbranch= NULL;
I32 word_idx;
PerlIO_printf(Perl_debug_log, "%*s%s ",
(int)(2*(indent+3)), "",
- elem_ptr ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60,
- PL_colors[0], PL_colors[1],
- (SvUTF8(*elem_ptr) ? PERL_PV_ESCAPE_UNI : 0) |
- PERL_PV_PRETTY_ELLIPSES |
- PERL_PV_PRETTY_LTGT
+ elem_ptr
+ ? pv_pretty(sv, SvPV_nolen_const(*elem_ptr),
+ SvCUR(*elem_ptr), 60,
+ PL_colors[0], PL_colors[1],
+ (SvUTF8(*elem_ptr)
+ ? PERL_PV_ESCAPE_UNI
+ : 0)
+ | PERL_PV_PRETTY_ELLIPSES
+ | PERL_PV_PRETTY_LTGT
)
- : "???"
+ : "???"
);
if (trie->jump) {
U16 dist= trie->jump[word_idx+1];
PerlIO_printf(Perl_debug_log, "(%"UVuf")\n",
- (UV)((dist ? this_trie + dist : next) - start));
+ (UV)((dist ? this_trie + dist : next) - start));
if (dist) {
if (!nextbranch)
- nextbranch= this_trie + trie->jump[0];
+ nextbranch= this_trie + trie->jump[0];
DUMPUNTIL(this_trie + dist, nextbranch);
}
if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
indent++;
}
CLEAR_OPTSTART;
-#ifdef DEBUG_DUMPUNTIL
+#ifdef DEBUG_DUMPUNTIL
PerlIO_printf(Perl_debug_log, "--- %d\n", (int)indent);
#endif
return node;
projects / platform / upstream / perl.git / commitdiff