From 8a9790076d97c00dd588f0645f866e2fbc8a8414 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 6 Jul 2026 09:07:11 -0600 Subject: [PATCH 01/21] utf8_length(): Assert input positioned properly I rewrote this function in 2019 via 71d63d0dc to do advancing per-word versus by character for long enough strings, thus saving significant amounts of execution time. FYI, at the bottom is a copy of some of the data presented in that commit message. The function traditionally did just a bit of syntax error checking of the parsed string. I chose to not add any, since the goal was speed, but also chose to not take any away, so that it would behave the same as always. That caused a tiny bit of slowdown than if checking were eliminated. This commit adds a new check at the beginning of the function in the form of an assert (active only in DEBUG builds) that the input string is positioned at the beginning of a character. This should have been a no-brainer, adding essentially nothing and verifying an important sanity criterium ------------------------- Data from 2019 commit Very long strings run an order of magnitude fewer instructions than blead. Here are worst case scenarios (7 bytes after word boundary). The values are in terms of percent, with blead (at the time) always set to 100. Numbers above 100 are good; below bad string length 10000000 characters; 1 bytes per character blead patch ------ ------- Ir 100.00 814.53 Dr 100.00 1069.58 Dw 100.00 3296.55 COND 100.00 1575.83 IND 100.00 100.00 string length 5000000 characters; 2 bytes per character blead patch ------ ------- Ir 100.00 408.86 Dr 100.00 536.32 Dw 100.00 1698.31 COND 100.00 788.72 IND 100.00 100.00 string length 3333333 characters; 3 bytes per character blead patch ------ ------- Ir 100.00 273.64 Dr 100.00 358.56 Dw 100.00 1165.55 COND 100.00 526.35 IND 100.00 100.00 string length 2500000 characters; 4 bytes per character blead patch ------ ------- Ir 100.00 206.03 Dr 100.00 269.68 Dw 100.00 899.17 COND 100.00 395.17 IND 100.00 100.00 --- utf8.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/utf8.c b/utf8.c index e5fbb7088e59..3485e1043fda 100644 --- a/utf8.c +++ b/utf8.c @@ -2626,8 +2626,9 @@ Perl_utf8_to_uv_msgs_helper_(const U8 * const s0, =for apidoc utf8_length 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. +at C (which must be positioned at the start of a character) 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. @@ -2650,6 +2651,7 @@ STRLEN Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) { PERL_ARGS_ASSERT_UTF8_LENGTH; + assert(s0 == e || ! UTF8_IS_CONTINUATION(*s0)); STRLEN continuations = 0; STRLEN len = 0; From b50302416c79e4ed327e9cd3bc07caca99daf914 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 3 Jul 2026 09:44:45 -0600 Subject: [PATCH 02/21] utf8_length(): Change variable name 'len' is more associated with number of bytes; this is the number of characters, so use 'count' --- utf8.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/utf8.c b/utf8.c index 3485e1043fda..18059ff21d1b 100644 --- a/utf8.c +++ b/utf8.c @@ -2654,7 +2654,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) assert(s0 == e || ! UTF8_IS_CONTINUATION(*s0)); STRLEN continuations = 0; - STRLEN len = 0; + STRLEN count = 0; const U8 * s = s0; /* For EBCDIC and short strings, we count the characters. The boundary @@ -2676,12 +2676,12 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) goto warn_and_return; } - len++; + count++; s += expected_byte_count; } if (LIKELY(e == s)) { - return len; + return count; } warn_and_return: From 632d1783edec2424cba91a01802bee95e9259a6a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 04:34:55 -0600 Subject: [PATCH 03/21] XXX need api test utf8_length: Fix bug returning wrong length on malformed input The code works correctly if the input is well-formed. But it was returning a count of the bytes instead of characters for malformed input. It raised a 'utf8' warning, if enabled, before the bad return. --- utf8.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utf8.c b/utf8.c index 18059ff21d1b..491bcefd6ff6 100644 --- a/utf8.c +++ b/utf8.c @@ -2691,7 +2691,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) else ck_warner_d(packWARN(WARN_UTF8), "%s", unees); - return s - s0; + return count; } /* Count continuations, word-at-a-time. From 3545706ef3bb730cb25ec45b6a7960790e471cf9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 03:24:13 -0600 Subject: [PATCH 04/21] utf8_length: White space only. A future commit will surround the indented lines with a block, and will remove a block from the outdented ones. This commit leaves things in an apparent inconsistent state, but this will be fixed the commit after the next --- utf8.c | 111 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 56 insertions(+), 55 deletions(-) diff --git a/utf8.c b/utf8.c index 491bcefd6ff6..10665b67c1ec 100644 --- a/utf8.c +++ b/utf8.c @@ -2694,69 +2694,70 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) return count; } - /* 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; - - /* Process up to a full word boundary. */ - while (s < per_byte_end ) { - const Size_t skip = UTF8SKIP(s); + /* 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; - continuations += skip - 1; - s += skip; - } + /* Process up to a full word boundary. */ + while (s < per_byte_end ) { + const Size_t skip = UTF8SKIP(s); - /* Adjust back down any overshoot */ - continuations -= s - per_byte_end; - s = per_byte_end; + continuations += skip - 1; + s += skip; + } - do { /* Process per-word */ + /* Adjust back down any overshoot */ + continuations -= s - per_byte_end; + s = per_byte_end; - /* 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)) { - continuations++; - s++; - continue; - } + 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); - /* 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; + /* Process remainder per-byte */ + while (s < e) { + if (UTF8_IS_CONTINUATION(*s)) { + continuations++; + s++; + continue; } - continuations += expected_byte_count- 1; - s += expected_byte_count; - } while (s < e); + /* 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; + } - break; + continuations += expected_byte_count- 1; + s += expected_byte_count; + } while (s < e); + + break; } if (LIKELY(e == s)) { From 4657c56f06e2da8b3ab6f13a9e09e04f325c5ce9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 03:45:05 -0600 Subject: [PATCH 05/21] utf8_length: Change "do { } while" to plain while The next commit would otherwise potentially cause malformed input to read off the end of the buffer. --- utf8.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/utf8.c b/utf8.c index 10665b67c1ec..f2b6cf53294f 100644 --- a/utf8.c +++ b/utf8.c @@ -2747,7 +2747,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) } /* Here is a starter byte. Use UTF8SKIP from now on */ - do { + while (s < e) { ptrdiff_t expected_byte_count = UTF8SKIP(s); if (UNLIKELY(e - s < expected_byte_count)) { break; @@ -2755,7 +2755,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) continuations += expected_byte_count- 1; s += expected_byte_count; - } while (s < e); + } break; } From 1acecfd8247a8299f2876df6739902e7bc08a8fe Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 03:27:33 -0600 Subject: [PATCH 06/21] utf8_length: Split a loop into two. This is in preparation for the next commit to simplify things --- utf8.c | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/utf8.c b/utf8.c index f2b6cf53294f..2ac4c807f0ac 100644 --- a/utf8.c +++ b/utf8.c @@ -2738,15 +2738,17 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) s += PERL_WORDSIZE; } while (s + PERL_WORDSIZE <= e_limit); - /* Process remainder per-byte */ - while (s < e) { - if (UTF8_IS_CONTINUATION(*s)) { - continuations++; - s++; - continue; - } + /* 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++; + } - /* Here is a starter byte. Use UTF8SKIP from now on */ + /* Here, we have processed as much as we dare per-word. Count characters + * directly, using UTF8SKIP from now on */ while (s < e) { ptrdiff_t expected_byte_count = UTF8SKIP(s); if (UNLIKELY(e - s < expected_byte_count)) { @@ -2757,9 +2759,6 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) s += expected_byte_count; } - break; - } - if (LIKELY(e == s)) { return s - s0 - continuations; } From 0d08e1c57399ac4426316074a15c0141002b9059 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 03:18:52 -0600 Subject: [PATCH 07/21] utf8_length: Stop counting continuations sooner When nearing the end of the input string when counting continuations per-word, we switch to counting per-character, using UTF8SKIP. Prior to this commit, we counted continuations based on UTF8SKIP and later converted to characters. But it is simpler to convert the continuations count so far to a character count, and simply use that from then on --- utf8.c | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/utf8.c b/utf8.c index 2ac4c807f0ac..4b79944676fa 100644 --- a/utf8.c +++ b/utf8.c @@ -2653,7 +2653,6 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) PERL_ARGS_ASSERT_UTF8_LENGTH; assert(s0 == e || ! UTF8_IS_CONTINUATION(*s0)); - STRLEN continuations = 0; STRLEN count = 0; const U8 * s = s0; @@ -2693,10 +2692,10 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) return count; } + { /* Count continuations, word-at-a-time. */ + STRLEN continuations = 0; - /* Count continuations, word-at-a-time. - * - * We need to stop before the final start character in order to + /* 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; @@ -2747,6 +2746,12 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) s++; } + /* 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; + } + /* Here, we have processed as much as we dare per-word. Count characters * directly, using UTF8SKIP from now on */ while (s < e) { @@ -2755,17 +2760,14 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) break; } - continuations += expected_byte_count- 1; + count++; s += expected_byte_count; } if (LIKELY(e == s)) { - return s - s0 - continuations; + return count; } - /* Convert to characters */ - s -= continuations; - goto warn_and_return; } From 6ac7e1911f78d4d84ee3e5683249d23c3fef4e4a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 03:57:44 -0600 Subject: [PATCH 08/21] utf8_length: Avoid an extra check Instead of breaking out of the loop when we find an error go directly to the error-handling code. This skips an extra conditional after the loop for this case. --- utf8.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utf8.c b/utf8.c index 4b79944676fa..7657da226630 100644 --- a/utf8.c +++ b/utf8.c @@ -2757,7 +2757,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) while (s < e) { ptrdiff_t expected_byte_count = UTF8SKIP(s); if (UNLIKELY(e - s < expected_byte_count)) { - break; + goto warn_and_return; } count++; From 1f71aed2e31585084b2f486e5e91760c043b4312 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 04:05:14 -0600 Subject: [PATCH 09/21] utf8_length: Move error handling code to function end This is in preparation for the next commit --- utf8.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/utf8.c b/utf8.c index 7657da226630..2022ff6b67c8 100644 --- a/utf8.c +++ b/utf8.c @@ -2683,14 +2683,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) return count; } - 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); - - return count; + goto warn_and_return; } { /* Count continuations, word-at-a-time. */ STRLEN continuations = 0; @@ -2768,7 +2761,14 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) return count; } - goto warn_and_return; + 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); + + return count; } /* From 5012c1c7c90c34fa2e42d4677fe633b2f50e9f18 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 6 Jul 2026 14:51:59 -0600 Subject: [PATCH 10/21] utf8_length: Consolidate two areas of code Previous commits in this series have made these two areas identical except for comments, and have repositioned things so that they can easily be consolidated. --- utf8.c | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) diff --git a/utf8.c b/utf8.c index 2022ff6b67c8..8fd9204de516 100644 --- a/utf8.c +++ b/utf8.c @@ -2665,27 +2665,18 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) const U8 * const per_byte_end = WORTH_PER_WORD_LOOP(s0, e, 12); if (! per_byte_end) { - while (s < e) { /* Count characters directly */ - - /* 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)) { + /* Not worth per-word. This will always be the case when the input is + * empty, which needs special handling to prevent *e from being + * accessed */ + if (UNLIKELY(e <= s0)) { + if (e < s0) { /* Bad input */ goto warn_and_return; } - count++; - s += expected_byte_count; - } - - if (LIKELY(e == s)) { - return count; + return 0; } - - goto warn_and_return; } - { /* Count continuations, word-at-a-time. */ + else { /* Count continuations, word-at-a-time. */ STRLEN continuations = 0; /* We need to stop before the final start character in order to @@ -2748,6 +2739,10 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) /* Here, we have processed as much as we dare per-word. Count characters * directly, using UTF8SKIP from now on */ while (s < e) { + + /* 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; From b718d2787ac42f5c983d177f976ca4ddbf0161a0 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 8 Jul 2026 20:01:25 -0600 Subject: [PATCH 11/21] utf8_length: Generalize warning code This is in preparation for more possible types of warning messages --- utf8.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/utf8.c b/utf8.c index 8fd9204de516..0db507393f1f 100644 --- a/utf8.c +++ b/utf8.c @@ -2656,6 +2656,8 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) STRLEN count = 0; const U8 * s = s0; + 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 @@ -2670,6 +2672,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) * accessed */ if (UNLIKELY(e <= s0)) { if (e < s0) { /* Bad input */ + warn_text = unees; goto warn_and_return; } @@ -2745,6 +2748,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) * at the end */ ptrdiff_t expected_byte_count = UTF8SKIP(s); if (UNLIKELY(e - s < expected_byte_count)) { + warn_text = unees; goto warn_and_return; } @@ -2759,9 +2763,9 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) warn_and_return: if (PL_op) ck_warner_d(packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); + "%s in %s", warn_text, OP_DESC(PL_op)); else - ck_warner_d(packWARN(WARN_UTF8), "%s", unees); + ck_warner_d(packWARN(WARN_UTF8), "%s", warn_text); return count; } From 7342d2a11c2f3ec21793b41a67105f2d75bbae67 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2026 05:19:09 -0600 Subject: [PATCH 12/21] utf8_length: Replace 'if' by assert() Reading this code, I don't think the condition tested for by the 'if' can happen, but I added an assert in case I'm wrong. --- utf8.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/utf8.c b/utf8.c index 0db507393f1f..ac71ab06d5e4 100644 --- a/utf8.c +++ b/utf8.c @@ -2756,9 +2756,9 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) s += expected_byte_count; } - if (LIKELY(e == s)) { - return count; - } + /* Here, should have worked all the way through */ + assert(e == s); + return count; warn_and_return: if (PL_op) From c95b6ed5ec3b735ff56dedb07b0c707c4f64d5cf Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 07:04:43 -0600 Subject: [PATCH 13/21] utf8_length: Remove redundant check It is illegal to call this function with the start pointer beyond the end pointer. This is asserted against in PERL_ARGS_ASSERT_UTF8_LENGTH. Therefore no additional code is needed to check against that. --- utf8.c | 5 ----- 1 file changed, 5 deletions(-) diff --git a/utf8.c b/utf8.c index ac71ab06d5e4..aad7944674c5 100644 --- a/utf8.c +++ b/utf8.c @@ -2671,11 +2671,6 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) * empty, which needs special handling to prevent *e from being * accessed */ if (UNLIKELY(e <= s0)) { - if (e < s0) { /* Bad input */ - warn_text = unees; - goto warn_and_return; - } - return 0; } } From 6c72eabeee368ed26d61dd7c39b23d8280e42d62 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 07:48:53 -0600 Subject: [PATCH 14/21] utf8_length: Move declaration This is to enable this to still work on C++ after a future commit would otherwise fail to compile because of goto crossing initialization --- utf8.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/utf8.c b/utf8.c index aad7944674c5..c18ef953545a 100644 --- a/utf8.c +++ b/utf8.c @@ -2664,8 +2664,9 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) * 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); + - const U8 * const per_byte_end = WORTH_PER_WORD_LOOP(s0, e, 12); if (! per_byte_end) { /* Not worth per-word. This will always be the case when the input is * empty, which needs special handling to prevent *e from being From 3f941a31cbf1cef80c28f84bcc9a2ee749cd4d70 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 07:55:41 -0600 Subject: [PATCH 15/21] utf8_length: Move assert This is in preparation for future commits --- utf8.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/utf8.c b/utf8.c index c18ef953545a..74d8e9616542 100644 --- a/utf8.c +++ b/utf8.c @@ -2651,7 +2651,6 @@ STRLEN Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) { PERL_ARGS_ASSERT_UTF8_LENGTH; - assert(s0 == e || ! UTF8_IS_CONTINUATION(*s0)); STRLEN count = 0; const U8 * s = s0; @@ -2666,6 +2665,8 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) * time spent isn't large either way */ const U8 * per_byte_end = WORTH_PER_WORD_LOOP(s, e, 12); + /* Better be a character start */ + assert(! UTF8_IS_CONTINUATION(*s)); if (! per_byte_end) { /* Not worth per-word. This will always be the case when the input is @@ -2676,6 +2677,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) } } else { /* Count continuations, word-at-a-time. */ + STRLEN continuations = 0; /* We need to stop before the final start character in order to From 2c3e60f6246755f9c753701a1c079aad01db5c05 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 08:07:18 -0600 Subject: [PATCH 16/21] utf8_length: Store expression result in a variable This is in preparation for it being needed again. --- utf8.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/utf8.c b/utf8.c index 74d8e9616542..2d9acd81b84b 100644 --- a/utf8.c +++ b/utf8.c @@ -2744,8 +2744,9 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) /* 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)) { + U8 expected_byte_count = UTF8SKIP(s); + ptrdiff_t got_bytes = e - s; + if (UNLIKELY(got_bytes < expected_byte_count)) { warn_text = unees; goto warn_and_return; } From a75a3fe2c9f985ae469f6c15cf133ebb399300bd Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 14:34:13 -0600 Subject: [PATCH 17/21] Create utf8_length_maybe_partial() This function is like utf8_length, but has hooks for code that is reading from a non-rewindable byte stream to more easily handle input stopping in the middle of multi-byte characters. The function is marked API, but experimental. --- embed.fnc | 6 +- embed.h | 2 +- long_names.c | 8 +++ proto.h | 9 +++ utf8.c | 155 ++++++++++++++++++++++++++++++++++++++++++++------- utf8.h | 1 + 6 files changed, 158 insertions(+), 23 deletions(-) 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/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/utf8.c b/utf8.c index 2d9acd81b84b..2131756a38fa 100644 --- a/utf8.c +++ b/utf8.c @@ -2623,15 +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 (which must be positioned at the start of a character) 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 @@ -2648,13 +2713,24 @@ 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 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 @@ -2665,19 +2741,43 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) * time spent isn't large either way */ const U8 * per_byte_end = WORTH_PER_WORD_LOOP(s, e, 12); - /* Better be a character start */ - assert(! UTF8_IS_CONTINUATION(*s)); + if (partial_char_info && partial_char_info[1] > 0) { - if (! per_byte_end) { - /* Not worth per-word. This will always be the case when the input is - * empty, which needs special handling to prevent *e from being - * accessed */ - if (UNLIKELY(e <= s0)) { - return 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 { + + /* 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; } } - else { /* Count continuations, word-at-a-time. */ + if (s >= e) { + + /* 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; + } + + /* Better be a character start */ + assert(! UTF8_IS_CONTINUATION(*s)); + + /* No missing continuations left; start the real work from here */ + s0 = s; + + if (per_byte_end) { STRLEN continuations = 0; /* We need to stop before the final start character in order to @@ -2734,7 +2834,7 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) /* 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; + count += s - s0 - continuations; } /* Here, we have processed as much as we dare per-word. Count characters @@ -2747,8 +2847,15 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) U8 expected_byte_count = UTF8SKIP(s); ptrdiff_t got_bytes = e - s; if (UNLIKELY(got_bytes < expected_byte_count)) { - warn_text = unees; - goto warn_and_return; + 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++; @@ -2757,6 +2864,12 @@ Perl_utf8_length(pTHX_ const U8 * const s0, const U8 * const e) /* 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; + } + return count; warn_and_return: 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) From a44cc80b6522a24818ca99c93f036d3fe7c1d86e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 1 Jul 2026 05:57:52 -0600 Subject: [PATCH 18/21] pp_sys.c: Wrap comment to fit in 80 columns --- pp_sys.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/pp_sys.c b/pp_sys.c index 78e3dd057947..04e91e1ea283 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2147,9 +2147,10 @@ PP_wrapped(pp_sysread, 0, 1) 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 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; offset = bend - SvPVX_const(bufsv); From d53c33490820973de203ed3ba7bc92e680286dc2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 5 Jul 2026 09:07:30 -0600 Subject: [PATCH 19/21] pp_read: Change two variable names This code is used for 3 different ops. In the non-pp_read ones, the values are in bytes; in pp_read, they can be in characters as well. I found the names confusing given this intermixing. Changing the names of the two variables that always refer to character values helps lessen the confusion Also add a few clarifying comments --- pp_sys.c | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/pp_sys.c b/pp_sys.c index 04e91e1ea283..92dd4bca7d1e 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1924,15 +1924,15 @@ 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; + 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 */ bool charstart = FALSE; STRLEN charskip = 0; STRLEN skip = 0; @@ -1979,7 +1979,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; @@ -1995,7 +2000,7 @@ PP_wrapped(pp_sysread, 0, 1) 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) { @@ -2141,7 +2146,7 @@ PP_wrapped(pp_sysread, 0, 1) goto more_bytes; } else { - got++; + chars_got++; buffer += skip; charstart = TRUE; charskip = 0; @@ -2151,13 +2156,13 @@ PP_wrapped(pp_sysread, 0, 1) /* 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; + if (chars_got < chars_wanted && count == length) { + length = chars_wanted - chars_got; 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) { From 02accb8f49ac9a88e03f9d76db9ad07050581b38 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 16:51:28 -0600 Subject: [PATCH 20/21] pp_read: Use utf8_length_maybe_partial This results in significant speed improvements. See https://github.com/Perl/perl5/issues/24511 --- pp_sys.c | 96 +++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 64 insertions(+), 32 deletions(-) diff --git a/pp_sys.c b/pp_sys.c index 92dd4bca7d1e..63697f4f2702 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1933,11 +1933,9 @@ PP_wrapped(pp_sysread, 0, 1) SV *read_target; 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 */ - bool charstart = FALSE; - STRLEN charskip = 0; - STRLEN skip = 0; 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)) ) @@ -1997,9 +1995,6 @@ PP_wrapped(pp_sysread, 0, 1) blen = sv_len_utf8_nomg(bufsv); } - charstart = TRUE; - charskip = 0; - skip = 0; chars_wanted = length; /* Unused unless pp_read with a UTF-8 fp */ #ifdef HAS_SOCKET @@ -2129,38 +2124,75 @@ 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 { - chars_got++; - buffer += skip; - charstart = TRUE; - charskip = 0; - } - } + 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); - /* If we have not 'got' the number of _characters_ we 'wanted' get - * some more provided amount read (count) was what was requested - * (length) */ - if (chars_got < chars_wanted && count == length) { - length = chars_wanted - chars_got; offset = bend - SvPVX_const(bufsv); goto more_bytes; } + /* return value is character count */ count = chars_got; SvUTF8_on(bufsv); From b58cfaef92505f3a237464db2827b7702ecf097e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 9 Jul 2026 17:17:29 -0600 Subject: [PATCH 21/21] sv_gets_read_record: Use utf8_length_maybe_partial This is when $/ is set to an integer reference. This speeds up the process greatly, and simplifies the code here. --- sv.c | 94 ++++++++++++++++++++++-------------------------------------- 1 file changed, 34 insertions(+), 60 deletions(-) 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); } }