master: Decode utf8 from C

The branch "master" has been updated in SBCL:
       via  78ef4a508188c9732ece8a2ad74d984e2e1aa43e (commit)
      from  b3478e055b85c589cd08c1369bfd598a48b49db8 (commit)

- Log -----------------------------------------------------------------
commit 78ef4a508188c9732ece8a2ad74d984e2e1aa43e
Author: Douglas Katzman <[email protected]>
Date:   Sat Apr 4 23:00:28 2026 -0400

    Decode utf8 from C
    
    This improves the benchmark result for long strings and does not
    degrade it on short strings.
    
    And fix the benchmark's randomizer. The hacky attempt to avoid the
    surrogate pair range inadvertently prevented random strings from
    containing any code point requiring exactly 2 encoding bytes.
---
 benchmarks/utf8-to-string.lisp |  3 ++-
 src/code/target-unicode.lisp   | 40 +++++++++++++---------------------------
 src/runtime/runtime.c          | 34 ++++++++++++++++++++++++++++++++++
 tests/utf-8.pure.lisp          |  5 +++--
 4 files changed, 52 insertions(+), 30 deletions(-)

diff --git a/benchmarks/utf8-to-string.lisp b/benchmarks/utf8-to-string.lisp
index ad0f1112d..45ae82326 100644
--- a/benchmarks/utf8-to-string.lisp
+++ b/benchmarks/utf8-to-string.lisp
@@ -39,7 +39,8 @@
     (dotimes (i stringlen s)
       (setf (char s i)
             (code-char (if (< (random 100.0) unicode)
-                           (max #xE000 (random char-code-limit))
+                           (loop (let ((c (max 1 (random char-code-limit))))
+                                   (when (sb-unicode:scalar-p c) (return c))))
                            (max 1 (random 128))))))))
 
 (defun bench ()
diff --git a/src/code/target-unicode.lisp b/src/code/target-unicode.lisp
index 9ae0c833d..f5e7b2d45 100644
--- a/src/code/target-unicode.lisp
+++ b/src/code/target-unicode.lisp
@@ -2039,33 +2039,19 @@ according to the IDNA confusableSummary.txt table"
 (labels
     ((copy-to-char-string (sap length-in-octets nchars)
        (declare (sb-sys:system-area-pointer sap) (index length-in-octets nchars))
-       (macrolet
-           ;; This character decoder is taken from (one of several) UTF8->STRING
-           ;; functions in enc-basic without any of the CRLF conversions.
-           ;; The best solution - at least for #+(or arm64 x86-64) - would be to cons
-           ;; a DX file buffer and call SIMD-COPY-UTF8-TO-CHARACTER-STRING on it.
-           ((cref (n) `(sb-sys:sap-ref-8 sap ,n))
-            (utf8-char@sap (bytes)
-              `(ecase ,bytes
-                 (1 (cref 0))
-                 (2 (logior (ash (ldb (byte 5 0) (cref 0)) 6)
-                            (ldb (byte 6 0) (cref 1))))
-                 (3 (logior (ash (ldb (byte 4 0) (cref 0)) 12)
-                            (ash (ldb (byte 6 0) (cref 1)) 6)
-                            (ldb (byte 6 0) (cref 2))))
-                 (4 (logior (ash (ldb (byte 3 0) (cref 0)) 18)
-                            (ash (ldb (byte 6 0) (cref 1)) 12)
-                            (ash (ldb (byte 6 0) (cref 2)) 6)
-                            (ldb (byte 6 0) (cref 3)))))))
-         (let ((string (make-array nchars :element-type 'character))
-               (end-sap (sb-sys:sap+ sap length-in-octets))
-               (char-index -1))
-           (declare (sb-kernel:index-or-minus-1 char-index))
-           (loop
-            (let ((n (utf8-encoded-len-from-leading-byte (sb-sys:sap-ref-8 sap 0))))
-              (setf (char string (incf char-index)) (code-char (utf8-char@sap n)))
-              (when (sb-sys:sap>= (setf sap (sb-sys:sap+ sap n)) end-sap)
-                (return string)))))))
+       ;; It is generally quicker to call a foreign function to decode utf8,
+       ;; with the possible exception of strings shorter than a few characters.
+       (let* ((string (make-array nchars :element-type 'character))
+              (result
+               (sb-sys:with-pinned-objects (string)
+                 (sb-alien:alien-funcall
+                  (sb-alien:extern-alien "utf8_into_simple_character_string"
+                   (function sb-alien:unsigned
+                             sb-sys:system-area-pointer sb-alien:unsigned
+                             sb-alien:system-area-pointer))
+                  sap length-in-octets (sb-sys:vector-sap string)))))
+         (sb-int:aver (= result nchars))
+         string))
      (copy-to-base-string (sap nchars)
        (if (= nchars 0)
            #.(coerce "" 'simple-base-string)
diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c
index 295ee2b3c..8ff9059b5 100644
--- a/src/runtime/runtime.c
+++ b/src/runtime/runtime.c
@@ -809,3 +809,37 @@ initialize_lisp(int argc, char *argv[], char *envp[])
 }
 
 int lisp_gc_strategy_id() { return GC_STRATEGY_ID; }
+
+/**
+ * Convert UTF-8 to UCS4 assuming adequate output space and well-formed input.
+ *  input -  pointer to UTF-8 octets
+ *  in_len - number of octets to process
+ *  output - VECTOR-SAP of the resulting Lisp SIMPLE-CHARACTER-STRING
+ * Returns the number of UCS4 characters placed into 'output'
+ */
+size_t utf8_into_simple_character_string(const uint8_t* input, size_t in_len, uint32_t* output)
+{
+    const uint8_t* in = input;
+    const uint8_t* end = input + in_len;
+    uint32_t* out_start = output;
+
+    while (in < end) {
+        uint8_t first = *in++;
+        uint32_t c; // codepoint
+        if (first < 0x80) { // 1-byte sequence (0xxxxxxx)
+            c = first;
+        } else if (first < 0xE0) { // 2-byte sequence (110xxxxx 10xxxxxx)
+            c = ((first & 0x1F) << 6) | (in[0] & 0x3F);
+            in += 1;
+        } else if (first < 0xF0) { // 3-byte sequence (1110xxxx 10xxxxxx 10xxxxxx)
+            c = ((first & 0x0F) << 12) | ((in[0] & 0x3F) << 6) | (in[1] & 0x3F);
+            in += 2;
+        } else { // 4-byte sequence (11110xxx 10xxxxxx 10xxxxxx 10xxxxxx)
+            c = ((first & 0x07) << 18) | ((in[0] & 0x3F) << 12)
+              | ((in[1] & 0x3F) << 6) | (in[2] & 0x3F);
+            in += 3;
+        }
+        *output++ = c;
+    }
+    return output - out_start;
+}
diff --git a/tests/utf-8.pure.lisp b/tests/utf-8.pure.lisp
index c250e60b1..f70030e4c 100644
--- a/tests/utf-8.pure.lisp
+++ b/tests/utf-8.pure.lisp
@@ -435,7 +435,8 @@
     (dotimes (i stringlen s)
       (setf (char s i)
             (code-char (if (< (random 100.0) unicode)
-                           (max #xE000 (random char-code-limit))
+                           (loop (let ((c (max 1 (random char-code-limit))))
+                                   (when (sb-unicode:scalar-p c) (return c))))
                            (max 1 (random 128))))))))
 
 (with-test (:name :optimized-utf8-decoder
@@ -451,7 +452,7 @@
               (sb-sys:with-pinned-objects (octets)
                 (sb-unicode:utf8-decode-from-sap (sb-sys:vector-sap octets))))
              (readback3
-              ;; doesn't take END or a displaaced string. It could, but if you need
+              ;; doesn't take END or a displaced string. It could, but if you need
               ;; such capability, the SAP interface will do.
               (sb-unicode:utf8-decode-from-octets
                (subseq octets 0 (1- (length octets))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL