X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ddc1cd802cda73c79a0e7d26d1a4ce38023fe1f2..3c234b35e38131ab43732c73a916f4adff580d8c:/regcomp.c diff --git a/regcomp.c b/regcomp.c index 8475d9d..ec8b3c1 100644 --- a/regcomp.c +++ b/regcomp.c @@ -2647,13 +2647,13 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags } #ifdef DEBUGGING - /* Allow dumping */ + /* Allow dumping but overwriting the collection of skipped + * ops and/or strings with fake optimized ops */ n = scan + NODE_SZ_STR(scan); while (n <= stop) { - if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) { - OP(n) = OPTIMIZED; - NEXT_OFF(n) = 0; - } + OP(n) = OPTIMIZED; + FLAGS(n) = 0; + NEXT_OFF(n) = 0; n++; } #endif @@ -5824,19 +5824,87 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) /* This section of code defines the inversion list object and its methods. The * interfaces are highly subject to change, so as much as possible is static to - * this file. An inversion list is here implemented as a malloc'd C array with - * some added info. More will be coming when functionality is added later. + * this file. An inversion list is here implemented as a malloc'd C UV array + * with some added info that is placed as UVs at the beginning in a header + * portion. An inversion list for Unicode is an array of code points, sorted + * by ordinal number. The zeroth element is the first code point in the list. + * The 1th element is the first element beyond that not in the list. In other + * words, the first range is + * invlist[0]..(invlist[1]-1) + * The other ranges follow. Thus every element that is divisible by two marks + * the beginning of a range that is in the list, and every element not + * divisible by two marks the beginning of a range not in the list. A single + * element inversion list that contains the single code point N generally + * consists of two elements + * invlist[0] == N + * invlist[1] == N+1 + * (The exception is when N is the highest representable value on the + * machine, in which case the list containing just it would be a single + * element, itself. By extension, if the last range in the list extends to + * infinity, then the first element of that range will be in the inversion list + * at a position that is divisible by two, and is the final element in the + * list.) + * Taking the complement (inverting) an inversion list is quite simple, if the + * first element is 0, remove it; otherwise add a 0 element at the beginning. + * This implementation reserves an element at the beginning of each inversion list + * to contain 0 when the list contains 0, and contains 1 otherwise. The actual + * beginning of the list is either that element if 0, or the next one if 1. + * + * More about inversion lists can be found in "Unicode Demystified" + * Chapter 13 by Richard Gillam, published by Addison-Wesley. + * More will be coming when functionality is added later. * - * It is currently implemented as an SV pointing to an array of UVs that the SV - * thinks are bytes. This allows us to have an array of UV whose memory - * management is automatically handled by the existing facilities for SV's. + * The inversion list data structure is currently implemented as an SV pointing + * to an array of UVs that the SV thinks are bytes. This allows us to have an + * array of UV whose memory management is automatically handled by the existing + * facilities for SV's. * * Some of the methods should always be private to the implementation, and some * should eventually be made public */ +#define INVLIST_LEN_OFFSET 0 /* Number of elements in the inversion list */ +#define INVLIST_ITER_OFFSET 1 /* Current iteration position */ + +#define INVLIST_ZERO_OFFSET 2 /* 0 or 1; must be last element in header */ +/* The UV at position ZERO contains either 0 or 1. If 0, the inversion list + * contains the code point U+00000, and begins here. If 1, the inversion list + * doesn't contain U+0000, and it begins at the next UV in the array. + * Inverting an inversion list consists of adding or removing the 0 at the + * beginning of it. By reserving a space for that 0, inversion can be made + * very fast */ + +#define HEADER_LENGTH (INVLIST_ZERO_OFFSET + 1) + +/* Internally things are UVs */ +#define TO_INTERNAL_SIZE(x) ((x + HEADER_LENGTH) * sizeof(UV)) +#define FROM_INTERNAL_SIZE(x) ((x / sizeof(UV)) - HEADER_LENGTH) + #define INVLIST_INITIAL_LEN 10 PERL_STATIC_INLINE UV* +S__invlist_array_init(pTHX_ SV* const invlist, const bool will_have_0) +{ + /* Returns a pointer to the first element in the inversion list's array. + * This is called upon initialization of an inversion list. Where the + * array begins depends on whether the list has the code point U+0000 + * in it or not. The other parameter tells it whether the code that + * follows this call is about to put a 0 in the inversion list or not. + * The first element is either the element with 0, if 0, or the next one, + * if 1 */ + + UV* zero = get_invlist_zero_addr(invlist); + + PERL_ARGS_ASSERT__INVLIST_ARRAY_INIT; + + /* Must be empty */ + assert(! *get_invlist_len_addr(invlist)); + + /* 1^1 = 0; 1^0 = 1 */ + *zero = 1 ^ will_have_0; + return zero + *zero; +} + +PERL_STATIC_INLINE UV* S_invlist_array(pTHX_ SV* const invlist) { /* Returns the pointer to the inversion list's array. Every time the @@ -5845,28 +5913,37 @@ S_invlist_array(pTHX_ SV* const invlist) PERL_ARGS_ASSERT_INVLIST_ARRAY; - return (UV *) SvPVX(invlist); + /* Must not be empty */ + assert(*get_invlist_len_addr(invlist)); + assert(*get_invlist_zero_addr(invlist) == 0 + || *get_invlist_zero_addr(invlist) == 1); + + /* The array begins either at the element reserved for zero if the + * list contains 0 (that element will be set to 0), or otherwise the next + * element (in which case the reserved element will be set to 1). */ + return (UV *) (get_invlist_zero_addr(invlist) + + *get_invlist_zero_addr(invlist)); } -PERL_STATIC_INLINE UV -S_invlist_len(pTHX_ SV* const invlist) +PERL_STATIC_INLINE UV* +S_get_invlist_len_addr(pTHX_ SV* invlist) { - /* Returns the current number of elements in the inversion list's array */ + /* Return the address of the UV that contains the current number + * of used elements in the inversion list */ - PERL_ARGS_ASSERT_INVLIST_LEN; + PERL_ARGS_ASSERT_GET_INVLIST_LEN_ADDR; - return SvCUR(invlist) / sizeof(UV); + return (UV *) (SvPVX(invlist) + (INVLIST_LEN_OFFSET * sizeof (UV))); } PERL_STATIC_INLINE UV -S_invlist_max(pTHX_ SV* const invlist) +S_invlist_len(pTHX_ SV* const invlist) { - /* Returns the maximum number of elements storable in the inversion list's - * array, without having to realloc() */ + /* Returns the current number of elements in the inversion list's array */ - PERL_ARGS_ASSERT_INVLIST_MAX; + PERL_ARGS_ASSERT_INVLIST_LEN; - return SvLEN(invlist) / sizeof(UV); + return *get_invlist_len_addr(invlist); } PERL_STATIC_INLINE void @@ -5876,23 +5953,46 @@ S_invlist_set_len(pTHX_ SV* const invlist, const UV len) PERL_ARGS_ASSERT_INVLIST_SET_LEN; - SvCUR_set(invlist, len * sizeof(UV)); + *get_invlist_len_addr(invlist) = len; + + SvCUR_set(invlist, TO_INTERNAL_SIZE(len)); + /* If the list contains U+0000, that element is part of the header, + * and should not be counted as part of the array. It will contain + * 0 in that case, and 1 otherwise. So we could flop 0=>1, 1=>0 and + * subtract: + * SvCUR_set(invlist, + * TO_INTERNAL_SIZE(len + * - (*get_invlist_zero_addr(inv_list) ^ 1))); + * But, this is only valid if len is not 0. The consequences of not doing + * this is that the memory allocation code may think that the 1 more UV + * is being used than actually is, and so might do an unnecessary grow. + * That seems worth not bothering to make this the precise amount. + * + * Note that when inverting, SvCUR shouldn't change */ } -PERL_STATIC_INLINE void -S_invlist_set_max(pTHX_ SV* const invlist, const UV max) +PERL_STATIC_INLINE UV +S_invlist_max(pTHX_ SV* const invlist) { + /* Returns the maximum number of elements storable in the inversion list's + * array, without having to realloc() */ - /* Sets the maximum number of elements storable in the inversion list - * without having to realloc() */ + PERL_ARGS_ASSERT_INVLIST_MAX; - PERL_ARGS_ASSERT_INVLIST_SET_MAX; + return FROM_INTERNAL_SIZE(SvLEN(invlist)); +} - if (max < invlist_len(invlist)) { - Perl_croak(aTHX_ "panic: Can't make max size '%"UVuf"' less than current length %"UVuf" in inversion list", invlist_max(invlist), invlist_len(invlist)); - } +PERL_STATIC_INLINE UV* +S_get_invlist_zero_addr(pTHX_ SV* invlist) +{ + /* Return the address of the UV that is reserved to hold 0 if the inversion + * list contains 0. This has to be the last element of the heading, as the + * list proper starts with either it if 0, or the next element if not. + * (But we force it to contain either 0 or 1) */ - SvLEN_set(invlist, max * sizeof(UV)); + PERL_ARGS_ASSERT_GET_INVLIST_ZERO_ADDR; + + return (UV *) (SvPVX(invlist) + (INVLIST_ZERO_OFFSET * sizeof (UV))); } #ifndef PERL_IN_XSUB_RE @@ -5904,24 +6004,26 @@ Perl__new_invlist(pTHX_ IV initial_size) * space to store 'initial_size' elements. If that number is negative, a * system default is used instead */ + SV* new_list; + if (initial_size < 0) { initial_size = INVLIST_INITIAL_LEN; } /* Allocate the initial space */ - return newSV(initial_size * sizeof(UV)); -} -#endif + new_list = newSV(TO_INTERNAL_SIZE(initial_size)); + invlist_set_len(new_list, 0); -PERL_STATIC_INLINE void -S_invlist_destroy(pTHX_ SV* const invlist) -{ - /* Inversion list destructor */ + /* Force iterinit() to be used to get iteration to work */ + *get_invlist_iter_addr(new_list) = UV_MAX; - PERL_ARGS_ASSERT_INVLIST_DESTROY; + /* This should force a segfault if a method doesn't initialize this + * properly */ + *get_invlist_zero_addr(new_list) = UV_MAX; - SvREFCNT_dec(invlist); + return new_list; } +#endif STATIC void S_invlist_extend(pTHX_ SV* const invlist, const UV new_max) @@ -5930,7 +6032,7 @@ S_invlist_extend(pTHX_ SV* const invlist, const UV new_max) PERL_ARGS_ASSERT_INVLIST_EXTEND; - SvGROW((SV *)invlist, new_max * sizeof(UV)); + SvGROW((SV *)invlist, TO_INTERNAL_SIZE(new_max)); } PERL_STATIC_INLINE void @@ -5948,7 +6050,7 @@ S_invlist_trim(pTHX_ SV* const invlist) * etc */ #define ELEMENT_IN_INVLIST_SET(i) (! ((i) & 1)) -#define PREV_ELEMENT_IN_INVLIST_SET(i) ! ELEMENT_IN_INVLIST_SET(i) +#define PREV_ELEMENT_IN_INVLIST_SET(i) (! ELEMENT_IN_INVLIST_SET(i)) #ifndef PERL_IN_XSUB_RE void @@ -5958,14 +6060,16 @@ Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV * the end of the inversion list. The range must be above any existing * ones. */ - UV* array = invlist_array(invlist); + UV* array; UV max = invlist_max(invlist); UV len = invlist_len(invlist); PERL_ARGS_ASSERT__APPEND_RANGE_TO_INVLIST; - if (len > 0) { - + if (len == 0) { /* Empty lists must be initialized */ + array = _invlist_array_init(invlist, start == 0); + } + else { /* Here, the existing list is non-empty. The current max entry in the * list is generally the first value not in the set, except when the * set extends to the end of permissible values, in which case it is @@ -5973,6 +6077,7 @@ Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV * append out-of-order */ UV final_element = len - 1; + array = invlist_array(invlist); if (array[final_element] > start || ELEMENT_IN_INVLIST_SET(final_element)) { @@ -6004,10 +6109,13 @@ Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV * moved */ if (max < len) { invlist_extend(invlist, len); + invlist_set_len(invlist, len); /* Have to set len here to avoid assert + failure in invlist_array() */ array = invlist_array(invlist); } - - invlist_set_len(invlist, len); + else { + invlist_set_len(invlist, len); + } /* The next item on the list starts the range, the one after that is * one past the new range. */ @@ -6021,12 +6129,13 @@ Perl__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV invlist_set_len(invlist, len - 1); } } -#endif -STATIC SV* -S_invlist_union(pTHX_ SV* const a, SV* const b) +void +Perl__invlist_union(pTHX_ SV* const a, SV* const b, SV** output) { - /* Return a new inversion list which is the union of two inversion lists. + /* Take the union of two inversion lists and point 'result' to it. If + * 'result' on input points to one of the two lists, the reference count to + * that list will be decremented. * The basis for this comes from "Unicode Demystified" Chapter 13 by * Richard Gillam, published by Addison-Wesley, and explained at some * length there. The preface says to incorporate its examples into your @@ -6037,12 +6146,13 @@ S_invlist_union(pTHX_ SV* const a, SV* const b) * XXX A potential performance improvement is to keep track as we go along * if only one of the inputs contributes to the result, meaning the other * is a subset of that one. In that case, we can skip the final copy and - * return the larger of the input lists */ + * return the larger of the input lists, but then outside code might need + * to keep track of whether to free the input list or not */ - UV* array_a = invlist_array(a); /* a's array */ - UV* array_b = invlist_array(b); - UV len_a = invlist_len(a); /* length of a's array */ - UV len_b = invlist_len(b); + UV* array_a; /* a's array */ + UV* array_b; + UV len_a; /* length of a's array */ + UV len_b; SV* u; /* the resulting union */ UV* array_u; @@ -6060,12 +6170,42 @@ S_invlist_union(pTHX_ SV* const a, SV* const b) */ UV count = 0; - PERL_ARGS_ASSERT_INVLIST_UNION; + PERL_ARGS_ASSERT__INVLIST_UNION; + + /* If either one is empty, the union is the other one */ + len_a = invlist_len(a); + if (len_a == 0) { + if (output == &a) { + SvREFCNT_dec(a); + } + else if (output != &b) { + *output = invlist_clone(b); + } + /* else *output already = b; */ + return; + } + else if ((len_b = invlist_len(b)) == 0) { + if (output == &b) { + SvREFCNT_dec(b); + } + else if (output != &a) { + *output = invlist_clone(a); + } + /* else *output already = a; */ + return; + } + + /* Here both lists exist and are non-empty */ + array_a = invlist_array(a); + array_b = invlist_array(b); /* Size the union for the worst case: that the sets are completely * disjoint */ u = _new_invlist(len_a + len_b); - array_u = invlist_array(u); + + /* Will contain U+0000 if either component does */ + array_u = _invlist_array_init(u, (len_a > 0 && array_a[0] == 0) + || (len_b > 0 && array_b[0] == 0)); /* Go through each list item by item, stopping when exhausted one of * them */ @@ -6171,26 +6311,34 @@ S_invlist_union(pTHX_ SV* const a, SV* const b) } } - return u; + /* We may be removing a reference to one of the inputs */ + if (&a == output || &b == output) { + SvREFCNT_dec(*output); + } + + *output = u; + return; } -STATIC SV* -S_invlist_intersection(pTHX_ SV* const a, SV* const b) +void +Perl__invlist_intersection(pTHX_ SV* const a, SV* const b, SV** i) { - /* Return the intersection of two inversion lists. The basis for this - * comes from "Unicode Demystified" Chapter 13 by Richard Gillam, published - * by Addison-Wesley, and explained at some length there. The preface says - * to incorporate its examples into your code at your own risk. In fact, - * it had bugs + /* Take the intersection of two inversion lists and point 'i' to it. If + * 'i' on input points to one of the two lists, the reference count to that + * list will be decremented. + * The basis for this comes from "Unicode Demystified" Chapter 13 by + * Richard Gillam, published by Addison-Wesley, and explained at some + * length there. The preface says to incorporate its examples into your + * code at your own risk. In fact, it had bugs * * The algorithm is like a merge sort, and is essentially the same as the * union above */ - UV* array_a = invlist_array(a); /* a's array */ - UV* array_b = invlist_array(b); - UV len_a = invlist_len(a); /* length of a's array */ - UV len_b = invlist_len(b); + UV* array_a; /* a's array */ + UV* array_b; + UV len_a; /* length of a's array */ + UV len_b; SV* r; /* the resulting intersection */ UV* array_r; @@ -6208,12 +6356,35 @@ S_invlist_intersection(pTHX_ SV* const a, SV* const b) */ UV count = 0; - PERL_ARGS_ASSERT_INVLIST_INTERSECTION; + PERL_ARGS_ASSERT__INVLIST_INTERSECTION; + + /* If either one is empty, the intersection is null */ + len_a = invlist_len(a); + if ((len_a == 0) || ((len_b = invlist_len(b)) == 0)) { + *i = _new_invlist(0); + + /* If the result is the same as one of the inputs, the input is being + * overwritten */ + if (i == &a) { + SvREFCNT_dec(a); + } + else if (i == &b) { + SvREFCNT_dec(b); + } + return; + } + + /* Here both lists exist and are non-empty */ + array_a = invlist_array(a); + array_b = invlist_array(b); /* Size the intersection for the worst case: that the intersection ends up * fragmenting everything to be completely disjoint */ r= _new_invlist(len_a + len_b); - array_r = invlist_array(r); + + /* Will contain U+0000 iff both components do */ + array_r = _invlist_array_init(r, len_a > 0 && array_a[0] == 0 + && len_b > 0 && array_b[0] == 0); /* Go through each list item by item, stopping when exhausted one of * them */ @@ -6309,9 +6480,17 @@ S_invlist_intersection(pTHX_ SV* const a, SV* const b) } } - return r; + /* We may be removing a reference to one of the inputs */ + if (&a == i || &b == i) { + SvREFCNT_dec(*i); + } + + *i = r; + return; } +#endif + STATIC SV* S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end) { @@ -6322,7 +6501,6 @@ S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end) * with just the one range in it */ SV* range_invlist; - SV* added_invlist; UV len; if (invlist == NULL) { @@ -6347,15 +6525,12 @@ S_add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end) range_invlist = _new_invlist(2); _append_range_to_invlist(range_invlist, start, end); - added_invlist = invlist_union(invlist, range_invlist); + _invlist_union(invlist, range_invlist, &invlist); - /* The passed in list can be freed, as well as our temporary */ - invlist_destroy(range_invlist); - if (invlist != added_invlist) { - invlist_destroy(invlist); - } + /* The temporary can be freed */ + SvREFCNT_dec(range_invlist); - return added_invlist; + return invlist; } PERL_STATIC_INLINE SV* @@ -6363,6 +6538,163 @@ S_add_cp_to_invlist(pTHX_ SV* invlist, const UV cp) { return add_range_to_invlist(invlist, cp, cp); } +#ifndef PERL_IN_XSUB_RE +void +Perl__invlist_invert(pTHX_ SV* const invlist) +{ + /* Complement the input inversion list. This adds a 0 if the list didn't + * have a zero; removes it otherwise. As described above, the data + * structure is set up so that this is very efficient */ + + UV* len_pos = get_invlist_len_addr(invlist); + + PERL_ARGS_ASSERT__INVLIST_INVERT; + + /* The inverse of matching nothing is matching everything */ + if (*len_pos == 0) { + _append_range_to_invlist(invlist, 0, UV_MAX); + return; + } + + /* The exclusive or complents 0 to 1; and 1 to 0. If the result is 1, the + * zero element was a 0, so it is being removed, so the length decrements + * by 1; and vice-versa. SvCUR is unaffected */ + if (*get_invlist_zero_addr(invlist) ^= 1) { + (*len_pos)--; + } + else { + (*len_pos)++; + } +} +#endif + +PERL_STATIC_INLINE SV* +S_invlist_clone(pTHX_ SV* const invlist) +{ + + /* Return a new inversion list that is a copy of the input one, which is + * unchanged */ + + SV* new_invlist = _new_invlist(SvCUR(invlist)); + + PERL_ARGS_ASSERT_INVLIST_CLONE; + + Copy(SvPVX(invlist), SvPVX(new_invlist), SvCUR(invlist), char); + return new_invlist; +} + +#ifndef PERL_IN_XSUB_RE +void +Perl__invlist_subtract(pTHX_ SV* const a, SV* const b, SV** result) +{ + /* Point result to an inversion list which consists of all elements in 'a' + * that aren't also in 'b' */ + + PERL_ARGS_ASSERT__INVLIST_SUBTRACT; + + /* Subtracting nothing retains the original */ + if (invlist_len(b) == 0) { + + /* If the result is not to be the same variable as the original, create + * a copy */ + if (result != &a) { + *result = invlist_clone(a); + } + } else { + SV *b_copy = invlist_clone(b); + _invlist_invert(b_copy); /* Everything not in 'b' */ + _invlist_intersection(a, b_copy, result); /* Everything in 'a' not in + 'b' */ + SvREFCNT_dec(b_copy); + } + + if (result == &b) { + SvREFCNT_dec(b); + } + + return; +} +#endif + +PERL_STATIC_INLINE UV* +S_get_invlist_iter_addr(pTHX_ SV* invlist) +{ + /* Return the address of the UV that contains the current iteration + * position */ + + PERL_ARGS_ASSERT_GET_INVLIST_ITER_ADDR; + + return (UV *) (SvPVX(invlist) + (INVLIST_ITER_OFFSET * sizeof (UV))); +} + +PERL_STATIC_INLINE void +S_invlist_iterinit(pTHX_ SV* invlist) /* Initialize iterator for invlist */ +{ + PERL_ARGS_ASSERT_INVLIST_ITERINIT; + + *get_invlist_iter_addr(invlist) = 0; +} + +STATIC bool +S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end) +{ + UV* pos = get_invlist_iter_addr(invlist); + UV len = invlist_len(invlist); + UV *array; + + PERL_ARGS_ASSERT_INVLIST_ITERNEXT; + + if (*pos >= len) { + *pos = UV_MAX; /* Force iternit() to be required next time */ + return FALSE; + } + + array = invlist_array(invlist); + + *start = array[(*pos)++]; + + if (*pos >= len) { + *end = UV_MAX; + } + else { + *end = array[(*pos)++] - 1; + } + + return TRUE; +} + +#if 0 +void +S_invlist_dump(pTHX_ SV* const invlist, const char * const header) +{ + /* Dumps out the ranges in an inversion list. The string 'header' + * if present is output on a line before the first range */ + + UV start, end; + + if (header && strlen(header)) { + PerlIO_printf(Perl_debug_log, "%s\n", header); + } + invlist_iterinit(invlist); + while (invlist_iternext(invlist, &start, &end)) { + if (end == UV_MAX) { + PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. INFINITY\n", start); + } + else { + PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. 0x%04"UVXf"\n", start, end); + } + } +} +#endif + +#undef HEADER_LENGTH +#undef INVLIST_INITIAL_LENGTH +#undef TO_INTERNAL_SIZE +#undef FROM_INTERNAL_SIZE +#undef INVLIST_LEN_OFFSET +#undef INVLIST_ZERO_OFFSET +#undef INVLIST_ITER_OFFSET + /* End of inversion list object */ /* @@ -10036,10 +10368,9 @@ parseit: /* If folding and there are code points above 255, we calculate all * characters that could fold to or from the ones already on the list */ if (FOLD && nonbitmap) { - UV i; + UV start, end; /* End points of code point ranges */ SV* fold_intersection; - UV* fold_list; /* This is a list of all the characters that participate in folds * (except marks, etc in multi-char folds */ @@ -10076,23 +10407,13 @@ parseit: * be checked. Get the intersection of this class and all the * possible characters that are foldable. This can quickly narrow * down a large class */ - fold_intersection = invlist_intersection(PL_utf8_foldable, nonbitmap); + _invlist_intersection(PL_utf8_foldable, nonbitmap, &fold_intersection); /* Now look at the foldable characters in this class individually */ - fold_list = invlist_array(fold_intersection); - for (i = 0; i < invlist_len(fold_intersection); i++) { + invlist_iterinit(fold_intersection); + while (invlist_iternext(fold_intersection, &start, &end)) { UV j; - /* The next entry is the beginning of the range that is in the - * class */ - UV start = fold_list[i++]; - - - /* The next entry is the beginning of the next range, which - * isn't in the class, so the end of the current range is one - * less than that */ - UV end = fold_list[i] - 1; - /* Look at every character in the range */ for (j = start; j <= end; j++) { @@ -10214,16 +10535,14 @@ parseit: } } } - invlist_destroy(fold_intersection); + SvREFCNT_dec(fold_intersection); } /* Combine the two lists into one. */ if (l1_fold_invlist) { if (nonbitmap) { - SV* temp = invlist_union(nonbitmap, l1_fold_invlist); - invlist_destroy(nonbitmap); - nonbitmap = temp; - invlist_destroy(l1_fold_invlist); + _invlist_union(nonbitmap, l1_fold_invlist, &nonbitmap); + SvREFCNT_dec(l1_fold_invlist); } else { nonbitmap = l1_fold_invlist; @@ -10241,18 +10560,45 @@ parseit: * nothing like \w in it; some thought also would have to be given to the * interaction with above 0x100 chars */ if (! LOC - && (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT + && (ANYOF_FLAGS(ret) & ANYOF_INVERT) && ! unicode_alternate - && ! nonbitmap + /* In case of /d, there are some things that should match only when in + * not in the bitmap, i.e., they require UTF8 to match. These are + * listed in nonbitmap. */ + && (! nonbitmap + || ! DEPENDS_SEMANTICS + || (ANYOF_FLAGS(ret) & ANYOF_NONBITMAP_NON_UTF8)) && SvCUR(listsv) == initial_listsv_len) { - for (value = 0; value < ANYOF_BITMAP_SIZE; ++value) - ANYOF_BITMAP(ret)[value] ^= 0xFF; + if (! nonbitmap) { + for (value = 0; value < ANYOF_BITMAP_SIZE; ++value) + ANYOF_BITMAP(ret)[value] ^= 0xFF; + /* The inversion means that everything above 255 is matched */ + ANYOF_FLAGS(ret) |= ANYOF_UNICODE_ALL; + } + else { + /* Here, also has things outside the bitmap. Go through each bit + * individually and add it to the list to get rid of from those + * things not in the bitmap */ + SV *remove_list = _new_invlist(2); + _invlist_invert(nonbitmap); + for (value = 0; value < 256; ++value) { + if (ANYOF_BITMAP_TEST(ret, value)) { + ANYOF_BITMAP_CLEAR(ret, value); + remove_list = add_cp_to_invlist(remove_list, value); + } + else { + ANYOF_BITMAP_SET(ret, value); + } + } + _invlist_subtract(nonbitmap, remove_list, &nonbitmap); + SvREFCNT_dec(remove_list); + } + stored = 256 - stored; - /* The inversion means that everything above 255 is matched; and at the - * same time we clear the invert flag */ - ANYOF_FLAGS(ret) = ANYOF_UNICODE_ALL; + /* Clear the invert flag since have just done it here */ + ANYOF_FLAGS(ret) &= ~ANYOF_INVERT; } /* Folding in the bitmap is taken care of above, but not for locale (for @@ -10347,33 +10693,9 @@ parseit: } if (nonbitmap) { - UV* nonbitmap_array = invlist_array(nonbitmap); - UV nonbitmap_len = invlist_len(nonbitmap); - UV i; - - /* Here have the full list of items to match that aren't in the - * bitmap. Convert to the structure that the rest of the code is - * expecting. XXX That rest of the code should convert to this - * structure */ - for (i = 0; i < nonbitmap_len; i++) { - - /* The next entry is the beginning of the range that is in the - * class */ - UV start = nonbitmap_array[i++]; - UV end; - - /* The next entry is the beginning of the next range, which isn't - * in the class, so the end of the current range is one less than - * that. But if there is no next range, it means that the range - * begun by 'start' extends to infinity, which for this platform - * ends at UV_MAX */ - if (i == nonbitmap_len) { - end = UV_MAX; - } - else { - end = nonbitmap_array[i] - 1; - } - + UV start, end; + invlist_iterinit(nonbitmap); + while (invlist_iternext(nonbitmap, &start, &end)) { if (start == end) { Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\n", start); } @@ -10384,7 +10706,7 @@ parseit: start, end); } } - invlist_destroy(nonbitmap); + SvREFCNT_dec(nonbitmap); } if (SvCUR(listsv) == initial_listsv_len && ! unicode_alternate) {