master: Don't cons SAPs for sb-alien::c-string-to-string for :utf-8

The branch "master" has been updated in SBCL:
       via  ff7e3a1ca6c945b467d8f6854d8ec92dd6330257 (commit)
      from  8db96a30b55277d6791d0dca0983d4a3595dbe3a (commit)

- Log -----------------------------------------------------------------
commit ff7e3a1ca6c945b467d8f6854d8ec92dd6330257
Author: Stas Boukarev <[email protected]>
Date:   Wed Jun 17 17:27:17 2026 +0300

    Don't cons SAPs for sb-alien::c-string-to-string for :utf-8
---
 src/code/external-formats/enc-basic.lisp | 18 ++++++++++--------
 src/code/fd-stream.lisp                  | 11 +++++++----
 src/compiler/aliencomp.lisp              |  2 +-
 src/compiler/fndb.lisp                   | 17 +++++++++++++++++
 src/compiler/generic/utils.lisp          |  2 +-
 xperfecthash63.lisp-expr                 |  3 +++
 6 files changed, 39 insertions(+), 14 deletions(-)

diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index cb369aebc..2ecb4fe46 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -673,8 +673,6 @@
     (let* ((n (logand length (- sb-vm:n-word-bytes)))
            (string-sap (vector-sap string))
            (string-offset 0))
-      (declare (optimize sb-c::preserve-single-use-debug-variables
-                         sb-c::preserve-constants))
       (loop for byte-offset below n by sb-vm:n-word-bytes
             do
             (let ((word (sap-ref-word sap byte-offset)))
@@ -1195,7 +1193,7 @@
   :fd-stream-read-n-characters fd-stream-read-n-characters/utf-8
   :write-n-bytes-fun output-bytes/utf-8/lf
   :char-encodable-p (let ((bits (char-code |ch|))) (not (<= #xd800 bits #xdfff)))
-  :read-c-string-function read-from-c-string/utf-8/lf
+  :read-c-string-function read-from-c-string/utf-8/lf*
   :handle-size nil)
 
 (define-external-format/variable-width (:utf-8) t
@@ -1472,7 +1470,8 @@
               nil))
       (when decode-break-reason
         (c-string-decoding-error :utf-8 sap head decode-break-reason))
-      (when (zerop (char-code |ch|)) (return count)))))
+      (when (zerop (char-code |ch|)) (return count))))
+  (error "~s modified while validating UTF-8" sap))
 
 (declaim (inline word-has-zero-bytes))
 (defun word-has-zero-bytes (word)
@@ -1565,15 +1564,18 @@
              (t (return (values nil nil)))))
          (incf codepoints))))))
 
+
+;;; An entry point with boxed SAP for putting inside ef-read-c-string-fun
+(defun read-from-c-string/utf-8/lf* (sap element-type)
+  (read-from-c-string/utf-8/lf sap element-type))
+
 (defun read-from-c-string/utf-8/lf (sap element-type)
-  (declare (type system-area-pointer sap)
-           (optimize (sb-c:verify-arg-count 0)))
+  (declare (type system-area-pointer sap))
   (locally
       (declare (optimize (speed 3) (safety 0)))
     (multiple-value-bind (length all-ascii) (sb-vm::simd-utf8-strlen sap)
       (unless length
-        (find-bad-utf8 sap)
-        (error "~a modified while validating UTF-8" sap))
+        (find-bad-utf8 sap))
       (let* ((string
                (case element-type
                  (base-char (make-string length :element-type 'base-char))
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index b4a9423d7..ba912e8e2 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -926,10 +926,13 @@
 (defun sb-alien::c-string-to-string (sap external-format element-type)
   (declare (type system-area-pointer sap)
            (explicit-check :result))
-  (locally
-      (declare (optimize (speed 3) (safety 0)))
-    (let ((external-format (get-external-format-or-lose external-format)))
-      (funcall (ef-read-c-string-fun external-format) sap element-type))))
+  (if (eq external-format :utf-8)
+      (read-from-c-string/utf-8/lf sap element-type)
+      (locally
+          (declare (optimize (speed 3) (safety 0))
+                   (muffle-conditions compiler-note))
+        (let ((external-format (get-external-format-or-lose external-format)))
+          (funcall (ef-read-c-string-fun external-format) sap element-type)))))
 
 (defun get-external-format-or-lose (external-format)
   (or (get-external-format external-format)
diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp
index efae7dfe7..02c4a6d7d 100644
--- a/src/compiler/aliencomp.lisp
+++ b/src/compiler/aliencomp.lisp
@@ -83,7 +83,7 @@
                                                              simple-base-string)
     (movable flushable))
 (defknown sb-alien::c-string-to-string (system-area-pointer t t) simple-string
-    (movable flushable))
+    (movable fixed-args flushable))
 (defknown sb-alien::c-string-external-format * *
         (movable flushable))
 
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 618e5dabe..aa27d157c 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -2606,3 +2606,20 @@
 
 (defknown sb-kernel::single-float-invalid-operation (t single-float) nil (fixed-args))
 (defknown sb-kernel::double-float-invalid-operation (t double-float) nil (fixed-args))
+
+
+(defknown sb-impl::read-from-c-string/utf-8/lf (system-area-pointer t) simple-string
+    (movable flushable fixed-args))
+
+(defknown sb-vm::simd-utf8-strlen (system-area-pointer) (values t t)
+    (movable flushable fixed-args))
+
+(defknown sb-vm::simd-copy-utf8-sap-to-character-string
+    (system-area-pointer (simple-array character (*)) index)
+    t
+    (movable fixed-args))
+
+(defknown sb-impl::find-bad-utf8
+    (system-area-pointer)
+    nil
+    (movable fixed-args))
diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index 9a865c658..a34c1e4b3 100644
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -189,7 +189,7 @@
                               sc
                               (elt *float-regs* n))
                (descriptor))))
-        ((unsigned-byte-64 signed-byte-64)
+        ((system-area-pointer unsigned-byte-64 signed-byte-64)
          (let ((n (incf (#-c-stack-is-control-stack fixed-call-args-state-non-descriptors
                          #+c-stack-is-control-stack fixed-call-args-state-descriptors
                          state)))
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index 767d8f401..cc7182b8b 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1709,5 +1709,8 @@
 (#(EA1E569 42D83FFB 6634E9C8 825503B8 8D9B0A28 ADDD7F24)
  "(:ALLOW-OTHER-KEYS :FORM :PLIST :START-POSITIONS :CREATED :NAMESTRING)"
  "((& (^ (>> val 10) (>> val 28)) 7))")
+(#(1E21A5F9 2A6BF857 80D0C591 AC841474 CB6BDBB0)
+ "(SB-VM::SIGNED-BYTE-64 SB-VM::UNSIGNED-BYTE-64 SYSTEM-AREA-POINTER SINGLE-FLOAT DOUBLE-FLOAT)"
+ "((& (+ (>> val 4) (>> val 10)) 7))")
 )
 ;; EOF

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


hooks/post-receive
-- 
SBCL