diff --git a/embed.fnc b/embed.fnc index 455e4a5d263f..46e274bc2af5 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3983,8 +3983,12 @@ ARTdmp |U8 * |utf8_hop_safe |MPTR const U8 *s \ |SSize_t off \ |SPTR const U8 * const start \ |EPTRge const U8 * const end -ARdp |STRLEN |utf8_length |SPTR const U8 *s0 \ +ARdmp |STRLEN |utf8_length |SPTR const U8 *s0 \ |EPTRge const U8 *e +ARdp |STRLEN |utf8_length_maybe_partial \ + |SPTR const U8 *s0 \ + |EPTRge const U8 *e \ + |NULLOK U8 *partial_char_info ATdmp |UV |utf8n_to_uvchr |NN const U8 *s \ |STRLEN curlen \ |NULLOK STRLEN *retlen \ diff --git a/embed.h b/embed.h index d38b931e844f..4f456f9ea639 100644 --- a/embed.h +++ b/embed.h @@ -795,7 +795,7 @@ # define utf8_hop_back_overshoot Perl_utf8_hop_back_overshoot # define utf8_hop_forward_overshoot Perl_utf8_hop_forward_overshoot # define utf8_hop_overshoot Perl_utf8_hop_overshoot -# define utf8_length(a,b) Perl_utf8_length(aTHX_ a,b) +# define utf8_length_maybe_partial(a,b,c) Perl_utf8_length_maybe_partial(aTHX_ a,b,c) # define utf8_to_bytes(a,b) Perl_utf8_to_bytes(aTHX_ a,b) # define utf8_to_bytes_(a,b,c,d) Perl_utf8_to_bytes_(aTHX_ a,b,c,d) # define utf8_to_bytes_new_pv(a,b,c) Perl_utf8_to_bytes_new_pv(aTHX_ a,b,c) diff --git a/long_names.c b/long_names.c index 0acaac17035e..9d9d621a18a8 100644 --- a/long_names.c +++ b/long_names.c @@ -951,6 +951,14 @@ Perl_utf8_hop_safe(const U8 *s, SSize_t off, const U8 * const start, const U8 * return utf8_hop_safe(s, off, start, end); } +STRLEN +Perl_utf8_length(pTHX_ const U8 *s0, const U8 *e) +{ + PERL_ARGS_ASSERT_UTF8_LENGTH; + + return utf8_length(s0, e); +} + bool Perl_utf8_to_uv(const U8 * const s, const U8 * const e, UV *cp_p, Size_t *advance_p) { diff --git a/pp_sys.c b/pp_sys.c index 78e3dd057947..63697f4f2702 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1924,20 +1924,18 @@ PP_wrapped(pp_sysread, 0, 1) IO *io; char *buffer; STRLEN orig_size; - SSize_t length; + SSize_t length; /* How many bytes to read */ SSize_t count; SV *bufsv; STRLEN blen; int fp_utf8; int buffer_utf8; SV *read_target; - Size_t got = 0; - Size_t wanted; - bool charstart = FALSE; - STRLEN charskip = 0; - STRLEN skip = 0; + Size_t chars_got = 0; /* Only used in pp_read with a UTF-8 fp */ + Size_t chars_wanted; /* Only used in pp_read with a UTF-8 fp */ GV * const gv = MUTABLE_GV(*++MARK); int fd; + U8 partial_info[2] = { 0, 0 }; if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && gv && (io = GvIO(gv)) ) @@ -1979,7 +1977,12 @@ PP_wrapped(pp_sysread, 0, 1) "%s() isn't allowed on :utf8 handles", OP_DESC(PL_op)); } + + /* This function can handle UTF-8 input for pp_read. In that case, + * 'length', and 'wanted' count characters, not bytes.*/ + buffer = SvPVutf8_force(bufsv, blen); + /* UTF-8 may not have been set if they are all low bytes */ SvUTF8_on(bufsv); buffer_utf8 = 0; @@ -1992,10 +1995,7 @@ PP_wrapped(pp_sysread, 0, 1) blen = sv_len_utf8_nomg(bufsv); } - charstart = TRUE; - charskip = 0; - skip = 0; - wanted = length; + chars_wanted = length; /* Unused unless pp_read with a UTF-8 fp */ #ifdef HAS_SOCKET if (PL_op->op_type == OP_RECV) { @@ -2124,39 +2124,77 @@ PP_wrapped(pp_sysread, 0, 1) SvCUR_set(read_target, count+(buffer - SvPVX_const(read_target))); *SvEND(read_target) = '\0'; (void)SvPOK_only(read_target); + if (fp_utf8 && !IN_BYTES) { - /* Look at utf8 we got back and count the characters */ + + /* pp_read is the only OP implemented by this code that accepts UTF-8 + * handles. Its API is in terms of character counts instead of + * byte lengths. But the actual IO functions operate in terms of + * bytes. So conversions must be done. + * + * We have to assume that the input will all be single byte + * characters, because it could be, and if we requested more bytes + * than are ever going to be available, we could delay or hang the + * read() return unnecessarily. + * + * So above, we requested to read that many bytes. If there are any + * multi-byte characters present in the input, that number will be + * too small. If the read() returned all the bytes requested, there + * could be more already available, so we adjust the requested length + * and loop to get more, as many times as necessary. + * + * But if the read() returns fewer bytes than requested, the rest of + * the information isn't currently availabe, so we should return that + * to our caller to let them decide how to handle it. + * + * Except, we currently only return complete characters. Because of + * the 1 byte == 1 character assumption, the read can easily stop in + * the middle of a multi-byte character. We currently unconditionally + * loop to get the missing bytes, even if the read() has signalled + * that nothing is currently available. XXX khw thinks it would be + * better in that case if the complete characters are returned + * immediately, and the available bytes from that final character be + * cached so as to be prefixed when the caller next does a read. + * + * Above, we did the read(). Now convert the byte length that got + * returned into the number of actual characters */ const char *bend = buffer + count; - while (buffer < bend) { - if (charstart) { - skip = UTF8SKIP(buffer); - charskip = 0; - } - if (buffer - charskip + skip > bend) { - /* partial character - try for rest of it */ - length = skip - (bend-buffer); - offset = bend - SvPVX_const(bufsv); - charstart = FALSE; - charskip += count; - goto more_bytes; - } - else { - got++; - buffer += skip; - charstart = TRUE; - charskip = 0; - } - } - /* If we have not 'got' the number of _characters_ we 'wanted' get some more - provided amount read (count) was what was requested (length) - */ - if (got < wanted && count == length) { - length = wanted - got; + chars_got += utf8_length_maybe_partial((U8 *) buffer, (U8 *) bend, + partial_info); + + /* utf8_length_maybe_partial() signals that the final character was + * incomplete by not counting that character in its return value, and + * by setting 'partial_info[1]' to how many bytes are necessary + * to complete it. + * + * If we have read the requested number of complete characters, we are + * done, and can return immediately. Buf we never return a partial + * character, so always try the read again for those. + * + * In contrast, we do return fewer than the requested complete + * characters when the read() indicates that that's all the + * information it currently has available. */ + if ( partial_info[1] /* Must loop */ + + /* Need more info ... and it may be available */ + || (chars_got < chars_wanted && count == length)) + /* XXX Should PerlIO_get_cnt be checked too? */ + { + /* If this loop iteration actually read some bytes, we will need + * fewer next time. Recalculate. We need at least the missing + * ones required to complete a partial character, minus 1 to + * account for that character being completed, plus at least one + * for each character totally unread. (Using MAX makes sure this + * always evaluates to a sane value.) */ + length = MAX(1, chars_wanted - chars_got + + partial_info[1] - 1); + offset = bend - SvPVX_const(bufsv); goto more_bytes; } + /* return value is character count */ - count = got; + count = chars_got; SvUTF8_on(bufsv); } else if (buffer_utf8) { diff --git a/proto.h b/proto.h index 8254c26fc5ec..127452d4e9be 100644 --- a/proto.h +++ b/proto.h @@ -8135,6 +8135,15 @@ Perl_utf8_length(pTHX_ const U8 *s0, const U8 *e) #define PERL_ARGS_ASSERT_UTF8_LENGTH \ Perl_assert_aTHX; assert(s0); assert(e); assert(s0 <= e) +PERL_CALLCONV STRLEN +Perl_utf8_length_maybe_partial(pTHX_ const U8 *s0, const U8 *e, U8 *partial_char_info) + Perl_attribute_nonnull_aTHX + Perl_attribute_nonnull(pTHX_1) + Perl_attribute_nonnull(pTHX_2) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_UTF8_LENGTH_MAYBE_PARTIAL \ + Perl_assert_aTHX; assert(s0); assert(e); assert(s0 <= e) + PERL_CALLCONV U8 * Perl_utf8_to_bytes(pTHX_ U8 *s, STRLEN *lenp) Perl_attribute_nonnull_aTHX diff --git a/sv.c b/sv.c index 6806d90e313c..2e2a409df63e 100644 --- a/sv.c +++ b/sv.c @@ -9577,70 +9577,44 @@ S_sv_gets_read_record(pTHX_ SV *const sv, PerlIO *const fp, SSize_t append) char *bend = buffer + bytesread; char *bufp = buffer; size_t charcount = 0; - bool charstart = TRUE; - STRLEN skip = 0; - - while (charcount < recsize) { - /* count accumulated characters */ - while (bufp < bend) { - if (charstart) { - skip = UTF8SKIP(bufp); - } - if (bufp + skip > bend) { - /* partial at the end */ - charstart = FALSE; - break; - } - else { - ++charcount; - bufp += skip; - charstart = TRUE; - } + U8 partial_char_info[2] = { 0, 0 }; + + do { + charcount += utf8_length_maybe_partial((U8 *) bufp, (U8 *) bend, + partial_char_info); + /* Done if got enough with nothing dangling */ + if (charcount >= recsize && partial_char_info[1] == 0) { + break; } - if (charcount < recsize) { - STRLEN readsize; - STRLEN bufp_offset = bufp - buffer; - SSize_t morebytesread; - - /* originally I read enough to fill any incomplete - character and the first byte of the next - character if needed, but if there's many - multi-byte encoded characters we're going to be - making a read call for every character beyond - the original read size. - - So instead, read the rest of the character if - any, and enough bytes to match at least the - start bytes for each character we're going to - read. + /* Read enough bytes to match at least the start bytes for + * each character we're going to read, plus the missing + * continuation bytes for an uncompleted character (minus 1 to + * account for that character being completed). (Using MAX + * makes sure this always evaluates to a sane value.) */ + STRLEN readsize = MAX(1, recsize - charcount + + partial_char_info[1] - 1); + + buffer = SvGROW(sv, append + bytesread + readsize + 1) + append; + bend = buffer + bytesread; + SSize_t morebytesread = PerlIO_read(fp, bend, readsize); + if (morebytesread <= 0) { + /* we're done, if we still have incomplete + characters the check code in sv_gets() will warn about + them. + + I'd originally considered doing PerlIO_ungetc() on all + but the lead character of the incomplete character, + but read() doesn't do that, so I don't. */ - if (charstart) - readsize = recsize - charcount; - else - readsize = skip - (bend - bufp) + recsize - charcount - 1; - buffer = SvGROW(sv, append + bytesread + readsize + 1) + append; - bend = buffer + bytesread; - morebytesread = PerlIO_read(fp, bend, readsize); - if (morebytesread <= 0) { - /* we're done, if we still have incomplete - characters the check code in sv_gets() will - warn about them. - - I'd originally considered doing - PerlIO_ungetc() on all but the lead - character of the incomplete character, but - read() doesn't do that, so I don't. - */ - break; - } - - /* prepare to scan some more */ - bytesread += morebytesread; - bend = buffer + bytesread; - bufp = buffer + bufp_offset; + break; } - } + + /* prepare for next iteration */ + bufp = buffer + bytesread; + bytesread += morebytesread; + bend = bufp + morebytesread; + } while (true); } } diff --git a/utf8.c b/utf8.c index e5fbb7088e59..2131756a38fa 100644 --- a/utf8.c +++ b/utf8.c @@ -2623,14 +2623,80 @@ Perl_utf8_to_uv_msgs_helper_(const U8 * const s0, } /* -=for apidoc utf8_length +=for apidoc utf8_length +=for apidoc_item utf8_length_maybe_partial + +These each return the number of complete characters in the sequence of +UTF-8-encoded bytes starting at C and ending at the byte just before C. +Their purpose is to quickly do the count on inputs known to be syntactically +valid UTF-8; only minimal error checking is done. + +The difference between them is that C has extra +hooks to aid code that is reading from a byte-oriented stream where the +read can stop in the middle of a character, leaving that character only +partially specified. + +C will die under DEBUGGING builds if the first byte doesn't start +a character, and raises a warning in the C class if the final one is +incomplete. + +C takes an extra parameter that returns to the +caller that the final character needs some continuation bytes to fully specify +it, and/or that the first bytes in the sequence should form the completion of +such a character (likely left over from a previous call). + +Again, both functions return the number of complete characters encountered in +the input. + +The input and may point to the same place, in which case 0 is returned +with no warning raised nor other action taken. + +The returned value will likely be wrong unless the input is well-formed UTF-8. +You may instead want to use C> and similar that +verify the correctness of the string, while also counting how many characters +it contains. Their validity checking slow these functions down greatly +compared to the ones documented here. + +C takes an extra parameter, a pointer to an array +of two U8 elements. If the pointer is NULL, the function's behavior is +identical to C. Otherwise, upon return, the two elements will be +set to give information about any trailing partial character in the input. +If the input sequence ends with a complete character, both elements will be 0; +if it ends with a partial character, element C<[0]> will contain how many +bytes of that character actually are present in the input, and C<[1]> will +contain how many missing bytes are needed to form a complete character. + +On entry, element C<[0]> is always ignored; element C[<1]> is used so that the +sequence C may actually not have to start at the beginning of a character, +but that the first C<[1]> bytes are expected to be continuation bytes that +complete that character. Similarly to plain C, this function +dies on DEBUGGING builds if the next byte after these doesn't start a character. + +This extra parameter allows a caller of C to deal with partial characters in various ways. Typically, -Returns the number of characters in the sequence of UTF-8-encoded bytes starting -at C and ending at the byte just before C. If and point to the -same place, it returns 0 with no warning raised. -If C s> or if the scan would end up past C, it raises a UTF8 warning -and returns the number of valid characters. +=over + +=item 1 + +It can simply pass the partial bytes back to its caller to handle. + +=item 2 + +It can read some more and append any new bytes to the end of what has already +been read. + +=item 3 + +It can cache the bytes comprising the partial character returned, and return +to its caller up through the final completed character, then prepend those +bytes to the next call. + +=back + +The only checking this function does is to make sure that C isn't less than +C on input, and that the final few bytes of the input form complete +syntactically valid characters. =cut @@ -2647,124 +2713,173 @@ and returns the number of valid characters. */ STRLEN -Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) +Perl_utf8_length_maybe_partial(pTHX_ const U8 * s0, const U8 * const e, + U8 * partial_char_info) { - PERL_ARGS_ASSERT_UTF8_LENGTH; + PERL_ARGS_ASSERT_UTF8_LENGTH_MAYBE_PARTIAL; - STRLEN continuations = 0; - STRLEN len = 0; + STRLEN count = 0; const U8 * s = s0; + /* If we have hanging continuations missing from the previous call, gobble + * as many up as there are available and needed */ + if (partial_char_info) { + while (s < e && partial_char_info[1] > 0 && UTF8_IS_CONTINUATION(*s)) { + s++; + partial_char_info[1]--; + partial_char_info[0]++; + } + } + + const char * warn_text = NULL; + /* For EBCDIC and short strings, we count the characters. The boundary * was determined by eyeballing the output of Porting/bench.pl and * choosing a number where the continuations method gave better results (on * a 64 bit system, khw not having access to a 32 bit system with * cachegrind). The number isn't critical, as at these sizes, the total * time spent isn't large either way */ + const U8 * per_byte_end = WORTH_PER_WORD_LOOP(s, e, 12); + + if (partial_char_info && partial_char_info[1] > 0) { + + /* To get here, we need more continuations, but the next byte isn't + * one. */ + warn_text = unexpected_non_continuation_text(s0 - partial_char_info[0], + partial_char_info[0] + + partial_char_info[1], + s - s0, + partial_char_info[1]); + goto warn_and_return; + } + else { - const U8 * const per_byte_end = WORTH_PER_WORD_LOOP(s0, e, 12); - if (! per_byte_end) { - while (s < e) { /* Count characters directly */ + /* To get here, we have parsed any expected initial continuations. If + * there were some, it means we have completed the previous partial + * character */ + if (s > s0) { + count = 1; + } + } - /* Take extra care to not exceed 'e' (which would be undefined - * behavior) should the input be malformed, with a partial - * character at the end */ - ptrdiff_t expected_byte_count = UTF8SKIP(s); - if (UNLIKELY(e - s < expected_byte_count)) { - goto warn_and_return; - } + if (s >= e) { - len++; - s += expected_byte_count; - } + /* Here, we have parsed any expected and available initial + * continuations, and correspondingly adjusted how many are still + * expected. It could be that the input still doesn't extend to the + * end of the the first character. But we're all set up for next time */ + return count; + } - if (LIKELY(e == s)) { - return len; - } + /* Better be a character start */ + assert(! UTF8_IS_CONTINUATION(*s)); - warn_and_return: - if (PL_op) - ck_warner_d(packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); - else - ck_warner_d(packWARN(WARN_UTF8), "%s", unees); + /* No missing continuations left; start the real work from here */ + s0 = s; - return s - s0; - } + if (per_byte_end) { + STRLEN continuations = 0; - /* Count continuations, word-at-a-time. - * - * We need to stop before the final start character in order to - * preserve the limited error checking that's always been done */ - const U8 * e_limit = e - UTF8_MAXBYTES; + /* We need to stop before the final start character in order to + * preserve the limited error checking that's always been done */ + const U8 * e_limit = e - UTF8_MAXBYTES; - /* Process up to a full word boundary. */ - while (s < per_byte_end ) { - const Size_t skip = UTF8SKIP(s); + /* Process up to a full word boundary. */ + while (s < per_byte_end ) { + const Size_t skip = UTF8SKIP(s); - continuations += skip - 1; - s += skip; - } + continuations += skip - 1; + s += skip; + } - /* Adjust back down any overshoot */ - continuations -= s - per_byte_end; - s = per_byte_end; + /* Adjust back down any overshoot */ + continuations -= s - per_byte_end; + s = per_byte_end; - do { /* Process per-word */ + do { /* Process per-word */ + + /* The idea for counting continuation bytes came from + * https://www.daemonology.net/blog/2008-06-05-faster-utf8-strlen.html + * One thing it does that this doesn't is to prefetch the buffer + * __builtin_prefetch(&s[256], 0, 0); + * + * A continuation byte has the upper 2 bits be '10', and the rest + * dont-cares. The VARIANTS mask zeroes out all but the upper bit + * of each byte in the word. That gets shifted to the byte's + * lowest bit, and 'anded' with the complement of the 2nd highest + * bit of the byte, which has also been shifted to that position. + * Hence the bit in that position will be 1 iff the upper bit is 1 + * and the next one is 0. We then use the same integer + * multiplcation and shifting that are used in + * variant_under_utf8_count() to count how many of those are set + * in the word. */ + + continuations += (((((* (const PERL_UINTMAX_T *) s) + & PERL_VARIANTS_WORD_MASK) >> 7) + & (((~ (* (const PERL_UINTMAX_T *) s))) >> 6)) + * PERL_COUNT_MULTIPLIER) + >> ((PERL_WORDSIZE - 1) * CHARBITS); + s += PERL_WORDSIZE; + } while (s + PERL_WORDSIZE <= e_limit); - /* The idea for counting continuation bytes came from - * https://www.daemonology.net/blog/2008-06-05-faster-utf8-strlen.html - * One thing it does that this doesn't is to prefetch the buffer - * __builtin_prefetch(&s[256], 0, 0); - * - * A continuation byte has the upper 2 bits be '10', and the rest - * dont-cares. The VARIANTS mask zeroes out all but the upper bit of - * each byte in the word. That gets shifted to the byte's lowest bit, - * and 'anded' with the complement of the 2nd highest bit of the byte, - * which has also been shifted to that position. Hence the bit in that - * position will be 1 iff the upper bit is 1 and the next one is 0. We - * then use the same integer multiplcation and shifting that are used - * in variant_under_utf8_count() to count how many of those are set in - * the word. */ - - continuations += (((((* (const PERL_UINTMAX_T *) s) - & PERL_VARIANTS_WORD_MASK) >> 7) - & (((~ (* (const PERL_UINTMAX_T *) s))) >> 6)) - * PERL_COUNT_MULTIPLIER) - >> ((PERL_WORDSIZE - 1) * CHARBITS); - s += PERL_WORDSIZE; - } while (s + PERL_WORDSIZE <= e_limit); - - /* Process remainder per-byte */ - while (s < e) { - if (UTF8_IS_CONTINUATION(*s)) { + /* Using 'e_limit' causes us to finish a bit early, so that there is + * always at least one character left. If we're in the middle of one, + * finish it out. Note there is no check that the number of + * continuations for this character is correct */ + while (s < e && UTF8_IS_CONTINUATION(*s)) { continuations++; s++; - continue; } - /* Here is a starter byte. Use UTF8SKIP from now on */ - do { - ptrdiff_t expected_byte_count = UTF8SKIP(s); - if (UNLIKELY(e - s < expected_byte_count)) { - break; - } + /* Convert continuations to character count. The total number of + * characters is the total number of bytes minus the ones that are + * just continuations */ + count += s - s0 - continuations; + } - continuations += expected_byte_count- 1; - s += expected_byte_count; - } while (s < e); + /* Here, we have processed as much as we dare per-word. Count characters + * directly, using UTF8SKIP from now on */ + while (s < e) { - break; + /* Take extra care to not exceed 'e' (which would be undefined + * behavior) should the input be malformed, with a partial character + * at the end */ + U8 expected_byte_count = UTF8SKIP(s); + ptrdiff_t got_bytes = e - s; + if (UNLIKELY(got_bytes < expected_byte_count)) { + if (partial_char_info) { + partial_char_info[0] = got_bytes; + partial_char_info[1] = expected_byte_count - got_bytes; + return count; + } + else { + warn_text = unees; + goto warn_and_return; + } + } + + count++; + s += expected_byte_count; } - if (LIKELY(e == s)) { - return s - s0 - continuations; + /* Here, should have worked all the way through */ + assert(e == s); + + /* This return is for a complete character */ + if (partial_char_info) { + partial_char_info[0] = partial_char_info[1] = 0; } - /* Convert to characters */ - s -= continuations; + return count; + + warn_and_return: + if (PL_op) + ck_warner_d(packWARN(WARN_UTF8), + "%s in %s", warn_text, OP_DESC(PL_op)); + else + ck_warner_d(packWARN(WARN_UTF8), "%s", warn_text); - goto warn_and_return; + return count; } /* diff --git a/utf8.h b/utf8.h index 9583e0af4dfa..e57bce5056e4 100644 --- a/utf8.h +++ b/utf8.h @@ -206,6 +206,7 @@ For details, see the description for L. #define foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0) +#define utf8_length(s, e) utf8_length_maybe_partial(s, e, NULL) #define FOLDEQ_UTF8_NOMIX_ASCII (1 << 0) #define FOLDEQ_LOCALE (1 << 1) #define FOLDEQ_S1_ALREADY_FOLDED (1 << 2)